Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-9
Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 16-33) - Update from CVS - Install ERC. - Fix ERC compiler warnings. - Use utf-8 encoding in ERC ChangeLogs. - Merge ERC-related Viper hacks into Viper. - Merge from erc--main--0 - Merge from gnus--rel--5.10 * gnus--rel--5.10 (patch 8-13) - Merge from emacs--devo--0 - Update from CVS
This commit is contained in:
Miles Bader
commit
06eb776d8e
156 changed files with 45921 additions and 14632 deletions
23
ChangeLog
23
ChangeLog
|
|
@ -1,3 +1,26 @@
|
|||
2006-01-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
|
||||
|
||||
* configure.in: Require GTK 2.4 or newer.
|
||||
* configure: Regenerate
|
||||
|
||||
2006-01-29 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* Makefile.in (install-arch-indep, uninstall): Add ERC.
|
||||
* info/dir (ERC): New entry.
|
||||
|
||||
2006-01-29 Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
* info/dir: Fix last change.
|
||||
|
||||
2006-01-28 Luc Teirlinck <teirllm@auburn.edu>
|
||||
|
||||
* Makefile.in (install-arch-indep, uninstall): Add rcirc.
|
||||
|
||||
2006-01-27 Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
* info/dir: Untabify the whole file.
|
||||
(Rcirc): New entry.
|
||||
|
||||
2006-01-12 Andreas Schwab <schwab@suse.de>
|
||||
|
||||
* configure.in: Move AC_AIX and AC_GNU_SOURCE before first compile
|
||||
|
|
|
|||
|
|
@ -497,7 +497,7 @@ install-arch-indep: mkdir info
|
|||
chmod a+r ${infodir}/dir); \
|
||||
fi; \
|
||||
cd ${srcdir}/info ; \
|
||||
for f in ada-mode* autotype* calc* ccmode* cl* dired-x* ebrowse* ediff* efaq* eintr* elisp* emacs* emacs-mime* emacs-xtra* eshell* eudc* flymake* forms* gnus* idlwave* info* message* mh-e* newsticker* org* pcl-cvs* pgg* reftex* sc* ses* sieve* speedbar* tramp* vip* widget* woman* smtpmail* url*; do \
|
||||
for f in ada-mode* autotype* calc* ccmode* cl* dired-x* ebrowse* ediff* efaq* eintr* elisp* emacs* emacs-mime* emacs-xtra* eshell* eudc* flymake* forms* gnus* idlwave* info* message* mh-e* newsticker* org* pcl-cvs* pgg* reftex* sc* ses* sieve* speedbar* tramp* vip* widget* woman* smtpmail* url* rcirc* erc*; do \
|
||||
(cd $${thisdir}; \
|
||||
${INSTALL_DATA} ${srcdir}/info/$$f ${infodir}/$$f; \
|
||||
chmod a+r ${infodir}/$$f); \
|
||||
|
|
@ -507,7 +507,7 @@ install-arch-indep: mkdir info
|
|||
thisdir=`/bin/pwd`; \
|
||||
if [ `(cd ${srcdir}/info && /bin/pwd)` != `(cd ${infodir} && /bin/pwd)` ]; \
|
||||
then \
|
||||
for f in ada-mode autotype calc ccmode cl dired-x ebrowse ediff efaq elisp eintr emacs emacs-mime emacs-xtra eshell eudc flymake forms gnus idlwave info message mh-e newsticker org pcl-cvs pgg reftex sc ses sieve speedbar tramp vip viper widget woman smtpmail url; do \
|
||||
for f in ada-mode autotype calc ccmode cl dired-x ebrowse ediff efaq elisp eintr emacs emacs-mime emacs-xtra eshell eudc flymake forms gnus idlwave info message mh-e newsticker org pcl-cvs pgg reftex sc ses sieve speedbar tramp vip viper widget woman smtpmail url rcirc erc; do \
|
||||
(cd $${thisdir}; \
|
||||
${INSTALL_INFO} --info-dir=${infodir} ${infodir}/$$f); \
|
||||
done; \
|
||||
|
|
@ -573,7 +573,7 @@ uninstall:
|
|||
done
|
||||
(cd ${archlibdir} && rm -f fns-*)
|
||||
-rm -rf ${libexecdir}/emacs/${version}
|
||||
(cd ${infodir} && rm -f cl* ada-mode* autotype* calc* ccmode* ebrowse* efaq* eintr elisp* eshell* eudc* idlwave* message* pcl-cvs* reftex* speedbar* tramp* widget* woman* dired-x* ediff* emacs* emacs-xtra* flymake* forms* gnus* info* mh-e* newsticker* org* sc* ses* vip* smtpmail* url*)
|
||||
(cd ${infodir} && rm -f cl* ada-mode* autotype* calc* ccmode* ebrowse* efaq* eintr elisp* eshell* eudc* idlwave* message* pcl-cvs* reftex* speedbar* tramp* widget* woman* dired-x* ediff* emacs* emacs-xtra* flymake* forms* gnus* info* mh-e* newsticker* org* sc* ses* vip* smtpmail* url* rcirc* erc*)
|
||||
(cd ${man1dir} && rm -f emacs${manext} emacsclient${manext} etags${manext} ctags${manext})
|
||||
(cd ${bindir} && rm -f $(EMACSFULL) $(EMACS))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2006-01-27 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* FOR-RELEASE: string allocation bugs fixed.
|
||||
|
||||
2005-12-13 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* FOR-RELEASE: Ensure MH-E 8.0 has been released.
|
||||
|
|
|
|||
|
|
@ -41,19 +41,8 @@ bitmap usage to a bitmap name, and second level maps bitmap name to
|
|||
a bitmap appearence.
|
||||
[Assigned to KFS]
|
||||
|
||||
* FATAL ERRORS
|
||||
|
||||
** Investigate reported crashes in compact_small_strings.
|
||||
|
||||
** Investigate reported crashes related to using an
|
||||
invalid pointer from string_free_list.
|
||||
|
||||
* BUGS
|
||||
|
||||
** Roland.Winkler@physik.uni-erlangen.de's Dec 3 bug report for align.el.
|
||||
|
||||
** Ronan Keryell's Sep 23 bug about "tramp sudo:: and version control on RCS"
|
||||
|
||||
** TCP server processes do not work on Windows.
|
||||
|
||||
TCP/IP server processes created with `make-network-process' consume
|
||||
|
|
|
|||
4
configure
vendored
4
configure
vendored
|
|
@ -10200,8 +10200,8 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "gtk"; then
|
|||
echo "$as_me: error: Conflicting options, --with-gtk is incompatible with --with-x-toolkit=${with_x_toolkit}" >&2;}
|
||||
{ (exit 1); exit 1; }; };
|
||||
fi
|
||||
GLIB_REQUIRED=2.0.1
|
||||
GTK_REQUIRED=2.0.1
|
||||
GLIB_REQUIRED=2.4
|
||||
GTK_REQUIRED=2.4
|
||||
GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
|
||||
|
||||
if test "X${with_pkg_config_prog}" != X; then
|
||||
|
|
|
|||
|
|
@ -2000,8 +2000,8 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "gtk"; then
|
|||
if test "$USE_X_TOOLKIT" != "none" && test "$USE_X_TOOLKIT" != "maybe"; then
|
||||
AC_MSG_ERROR([Conflicting options, --with-gtk is incompatible with --with-x-toolkit=${with_x_toolkit}]);
|
||||
fi
|
||||
GLIB_REQUIRED=2.0.1
|
||||
GTK_REQUIRED=2.0.1
|
||||
GLIB_REQUIRED=2.4
|
||||
GTK_REQUIRED=2.4
|
||||
GTK_MODULES="gtk+-2.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED"
|
||||
|
||||
dnl Check if --with-pkg-config-prog has been given.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,11 @@
|
|||
2006-01-29 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* NEWS: Add entry for ERC.
|
||||
|
||||
2006-01-27 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* TODO: Make SYNC_INPUT the default.
|
||||
|
||||
2006-01-25 Nick Roberts <nickrob@snap.net.nz>
|
||||
|
||||
* images/gud/pstar.xpm: Make background transparent.
|
||||
|
|
|
|||
599
etc/ERC-NEWS
Normal file
599
etc/ERC-NEWS
Normal file
|
|
@ -0,0 +1,599 @@
|
|||
ERC NEWS -*- outline -*-
|
||||
|
||||
* Changes since ERC 5.0.4
|
||||
|
||||
** Improve XEmacs compatibility.
|
||||
|
||||
** Namespace changes
|
||||
|
||||
*** Now ERC doesn't use global variable space.
|
||||
Renamed all variables that didn't start with "erc-".
|
||||
|
||||
o `away' is now `erc-away'
|
||||
|
||||
o `current-nick' is now `erc-server-current-nick'
|
||||
|
||||
o `last-peers' is now `erc-server-last-peers'
|
||||
|
||||
o `last-ping-time' is now `erc-server-last-ping-time'
|
||||
|
||||
o `last-sent-time' is now `erc-server-last-sent-time'
|
||||
|
||||
o `lines-sent' is now `erc-server-lines-sent'
|
||||
|
||||
o `quitting' is now `erc-server-quitting'
|
||||
|
||||
*** Remove the `with-erc-channel-buffer' function.
|
||||
|
||||
** Bugfixes
|
||||
|
||||
*** Don't inadvertently destroy face properties.
|
||||
|
||||
*** Load erc scripts in a safer way.
|
||||
|
||||
*** Don't insert a timestamp if text at point is invisible.
|
||||
|
||||
*** Don't hide messages from those in `erc-fools' by default.
|
||||
Color their nicks instead.
|
||||
|
||||
*** Use a more foolproof method of encoding and decoding strings
|
||||
before sending to a channel.
|
||||
|
||||
** Backend changes
|
||||
|
||||
*** Renamed some server-specific variables
|
||||
|
||||
o `erc-announced-server-name' is now `erc-server-announced-name'
|
||||
|
||||
o `erc-auto-reconnect' is now `erc-server-auto-reconnect'
|
||||
|
||||
o `erc-connect-function' is now `erc-server-connect-function'
|
||||
|
||||
o `erc-default-coding-system' is now `erc-server-coding-system'
|
||||
|
||||
o `erc-duplicate-timeout' is now `erc-server-duplicate-timeout'
|
||||
|
||||
o `erc-duplicates' is now `erc-server-duplicates'
|
||||
|
||||
o `erc-lag' is now `erc-server-lag'
|
||||
|
||||
o `erc-prevent-duplicates' is now `erc-server-prevent-duplicates'
|
||||
|
||||
o `erc-previous-read' is now `erc-server-filter-data'
|
||||
|
||||
o `erc-process' is now `erc-server-process'
|
||||
|
||||
o `erc-ping-handler' is now `erc-server-send-ping-handler'
|
||||
|
||||
o `erc-ping-interval' is now `erc-server-send-ping-interval'
|
||||
|
||||
*** Renamed some functions
|
||||
|
||||
o `erc-connect' is now `erc-server-connect'
|
||||
|
||||
o `erc-process-filter' is now `erc-server-filter-function'
|
||||
|
||||
o `erc-send-command' is now `erc-server-send'
|
||||
|
||||
o `erc-send-single-line' is now `erc-send-input'
|
||||
|
||||
o `erc-setup-periodical-server-ping' is now
|
||||
`erc-server-setup-periodical-server-ping'
|
||||
|
||||
o `erc-split-command is now `erc-split-line'
|
||||
|
||||
*** New options
|
||||
|
||||
o erc-server-flood-margin, erc-server-flood-penalty: New options
|
||||
that allow tweaking of flood control.
|
||||
|
||||
o erc-split-line-length: The maximum line length of a single
|
||||
message.
|
||||
|
||||
*** New variables
|
||||
|
||||
o erc-server-flood-last-message, erc-server-flood-queue,
|
||||
erc-server-flood-timer: Flood control.
|
||||
|
||||
o erc-server-processing-p: Indicate when we're currently processing
|
||||
a message.
|
||||
|
||||
*** Remove some options
|
||||
|
||||
o `erc-flood-limit'
|
||||
o `erc-flood-limit2'
|
||||
|
||||
** New customization group `erc-server' for dealing with IRC servers.
|
||||
|
||||
** ERC can now be installed by doing `make install' from the command line.
|
||||
|
||||
** ERC now has a manual in erc.texi.
|
||||
Type `make doc' to generate HTML and Info versions of it.
|
||||
|
||||
** ERC no longer depends on cl.el.
|
||||
Only the macros in cl-macs.el are used.
|
||||
|
||||
** Fix an edge case when quitting as new messages come in.
|
||||
|
||||
** Make flood protection toggle-able as on/off, removing the 'strict option.
|
||||
|
||||
** If possible, re-use channel buffers when reconnecting to a server.
|
||||
|
||||
** Text in ERC buffers is now read-only by default.
|
||||
To get the previous behavior,
|
||||
|
||||
** Changes and additions to modules
|
||||
|
||||
*** Auto-join (erc-autojoin.el)
|
||||
|
||||
**** Recognize the Azzurra server.
|
||||
|
||||
*** BBDB (erc-bbdb.el)
|
||||
|
||||
**** When the user types /WHOIS, ask for a record to merge to.
|
||||
|
||||
**** Store the displayed name of a BitlBee contact.
|
||||
The new `erc-bbdb-bitlbee-name-field' option specifies the field to use
|
||||
to store this information.
|
||||
|
||||
**** Don't prompt for a name on /JOIN or /NICK.
|
||||
|
||||
*** Button (erc-button.el)
|
||||
|
||||
**** Fix customization of `erc-button-alist'
|
||||
|
||||
**** New option `erc-button-nickname-face' determines the face to use
|
||||
when coloring ERC nicknames.
|
||||
|
||||
*** Channel tracking (erc-track.el)
|
||||
|
||||
**** Remove channels from the modified channels list if not currently
|
||||
connected. This should remove residue from the mode line after
|
||||
quitting ERC.
|
||||
|
||||
**** Recognize buttonized text
|
||||
|
||||
*** Highlighting (erc-match.el)
|
||||
|
||||
**** Highlight current nickname by default.
|
||||
|
||||
**** Added the option of beeping when certain matches occur.
|
||||
Add `erc-beep-on-match' to `erc-text-matched-hook' to enable
|
||||
beeping. Set the new variable `erc-beep-match-types' which match
|
||||
types that make beeps.
|
||||
|
||||
*** Nicklist (erc-nicklist.el)
|
||||
|
||||
**** Fix a couple of errors.
|
||||
|
||||
**** Make sure a stray mouse click doesn't trigger an error.
|
||||
|
||||
**** Insert icons from the /images directory next to nicks.
|
||||
This indicates their away status. The location is customizable via
|
||||
the new `erc-nicklist-icons-directory' option.
|
||||
|
||||
If you do not want these icons, set `erc-nicklist-use-icons' to nil.
|
||||
|
||||
*** Nickserv identification (erc-nickserv.el)
|
||||
|
||||
**** Recognize Azzurra and OFTC networks.
|
||||
|
||||
*** Old completion (erc-complete.el)
|
||||
|
||||
**** Disable by default.
|
||||
|
||||
*** Programmable completion (erc-pcomplete.el)
|
||||
|
||||
**** Enable by default.
|
||||
|
||||
*** Timestamps (erc-stamp.el)
|
||||
|
||||
**** On Emacs22, align right timestamps perfectly, even if variable-width
|
||||
characters are used. If we aren't using Emacs22, move text farther
|
||||
away from the right margin when variable-width characters are used.
|
||||
It is considered better to misalign the stamp by a bit than to go past
|
||||
the right margin.
|
||||
|
||||
**** Enable by default
|
||||
|
||||
** New modules
|
||||
|
||||
*** Spell-checking (erc-spelling.el)
|
||||
|
||||
**** Use flyspell in ERC.
|
||||
|
||||
*** Viper compatibility (erc-viper.el)
|
||||
|
||||
**** Helps ERC work correctly in viper-mode.
|
||||
|
||||
* Fixes since ERC 5.0.3
|
||||
|
||||
** Fix a problem with undo in channels.
|
||||
|
||||
* Fixes since ERC 5.0.2
|
||||
|
||||
** Fix typo in the `ctcp-request-to' entry of the English catalog.
|
||||
|
||||
** Debugging with edegug has been made easier in all of the
|
||||
erc-with-* and with-erc* macros.
|
||||
|
||||
** Non-ASCII character sets should be better supported when sending
|
||||
and processing messages.
|
||||
|
||||
** A load failure with erc-autoaway.el and Emacs21 has been fixed.
|
||||
|
||||
** A few XEmacs warnings were fixed.
|
||||
|
||||
** Changes and additions to modules
|
||||
|
||||
*** Backend (erc-backend.el)
|
||||
|
||||
**** Move the check for hidden messages into `erc-display-message'
|
||||
so there isn't so much replicated code.
|
||||
|
||||
**** Add `definition-name' property to constructed symbols so that
|
||||
`find-function' and `find-variable' will be able to locate them.
|
||||
|
||||
**** Make sure logs are inserted info the correct channel buffers.
|
||||
There was previously an error when using `erc-insert-log-on-open' in
|
||||
combination with autojoin to multiple channels.
|
||||
|
||||
*** Button (erc-button.el)
|
||||
|
||||
**** The layering of `erc-button-face' on other faces in ERC buffers
|
||||
has been improved.
|
||||
|
||||
*** Channel tracking (erc-track.el)
|
||||
|
||||
**** Use optimal amount of whitespace around modified channels
|
||||
indicator. Previously, there was an additional unnecessary space.
|
||||
|
||||
**** Fix an error that occurred when unchecked buffers existed when
|
||||
invoking /QUIT.
|
||||
|
||||
* Fixes since ERC 5.0.1
|
||||
|
||||
** If a channel key is required for a certain channel, ERC will prompt
|
||||
for one if `erc-prompt-for-channel-key' is non-nil.
|
||||
|
||||
** ERC doesn't try to reconnect if the network connection is refused
|
||||
when using `open-network-stream-nowait' as the `erc-connect-function'.
|
||||
|
||||
** Messages from multiple servers will not go to the currently active
|
||||
buffer. The messages from each server will be contained in the most
|
||||
recently active channel/server buffer that corresponds with the
|
||||
server.
|
||||
|
||||
** Some text messages were cleaned up slightly.
|
||||
|
||||
** Button faces should no longer "cover" other faces.
|
||||
|
||||
** Made some XEmacs compatibility fixes.
|
||||
|
||||
** Nicknames containing a backslash are now correctly highlighted as
|
||||
current-nick and buttonized as nicks.
|
||||
|
||||
** `erc-server-select' doesn't offer networks without servers as a
|
||||
choice anymore.
|
||||
|
||||
** Non-ASCII character support has been improved.
|
||||
|
||||
** Changes and additions to modules
|
||||
|
||||
*** Menu (erc-menu.el)
|
||||
|
||||
**** You can now save logs and truncate buffers from the menu-bar.
|
||||
|
||||
* Fixes since ERC 5.0
|
||||
|
||||
** Narrowing in ERC buffers no longer causes formatting errors.
|
||||
|
||||
** The BBDB module now loads correctly when customizing `erc-modules'.
|
||||
|
||||
** The value of `erc-button-face' is now respected.
|
||||
|
||||
** Fixed a bug which caused a read-only error during connection.
|
||||
|
||||
** Server buffers are now tracked correctly.
|
||||
This means that `erc-track-priority-faces-only', `erc-track-exclude',
|
||||
and `erc-track-exclude-types' now work with server buffers.
|
||||
|
||||
* Changes since ERC 4.0
|
||||
|
||||
** Channel members are now stored as a hash-table.
|
||||
`erc-server-users' and `erc-channel-users' are now hash-tables, rather
|
||||
than alists. This significantly increases performance, especially in
|
||||
large channels. Each channel member is stored as an `erc-server-user'
|
||||
struct, with additional information about the channels they are on
|
||||
stored in an `erc-channel-user' struct. Code using old alist-style
|
||||
channel members needs to be updated to work with hash-tables.
|
||||
This new code also removes the need for erc-members.el, which has been
|
||||
removed.
|
||||
|
||||
** The way ERC deals with input from the server has changed.
|
||||
All server response code is now in a new file, erc-backend.el. There
|
||||
should be no real user visible changes. There are, however, a few
|
||||
major changes for implementers, and module writers:
|
||||
|
||||
*** The PARSED response that all handlers get called with is
|
||||
no longer a vector, but an `erc-response' struct.
|
||||
|
||||
This means LESS MAGIC NUMBERS in the ERC source code, but a few
|
||||
changes in how you get at parsed responses.
|
||||
|
||||
The sender is accessed via `erc-response.sender'.
|
||||
|
||||
The command is accessed via `erc-response.command'.
|
||||
|
||||
The arguments to the command (everything after the command and
|
||||
before the colon) are accessed via `erc-response.command-args'.
|
||||
This is a /list/ of arguments in the order they appear in the
|
||||
unparsed response.
|
||||
|
||||
The contents of the response is accessed via
|
||||
`erc-response.contents'.
|
||||
|
||||
Should, for some reason, you want to do something with the
|
||||
/unparsed/ response, you can get it via `erc-response.unparsed'.
|
||||
|
||||
*** The `erc-server-hook-list' mechanism is gone.
|
||||
|
||||
All server response handlers should be defined with
|
||||
`define-erc-response-handler'. This defines functions and
|
||||
corresponding hook variables.
|
||||
|
||||
The mapping of server commands to hook variables is no longer
|
||||
done via `erc-event-to-hook', but through an #'equal hashtable,
|
||||
`erc-server-responses'. In order to find a hook you do:
|
||||
|
||||
(erc-get-hook command)
|
||||
|
||||
See the docstring of `define-erc-response-handler' for more
|
||||
information.
|
||||
|
||||
*** ALL hook variables have been renamed.
|
||||
|
||||
In accordance with recommendations in the Emacs Lisp manual,
|
||||
the hook variables are no longer called `erc-server-FOO-hook',
|
||||
but rather `erc-server-FOO-functions'. This is to indicate
|
||||
that the functions they call take arguments.
|
||||
|
||||
All the modules in ERC have been updated to reflect this change,
|
||||
but external module authors should beware.
|
||||
|
||||
** The values of `erc-mode-line-format' and `erc-header-line-format'
|
||||
are now defined as strings to be formatted using `format-spec'.
|
||||
`erc-mode-line-format' does not replace the whole mode-line anymore,
|
||||
only `mode-line-buffer-identification' is set. This way, personal
|
||||
mode-line configurations are not modified and all key bindings work as
|
||||
expected. The process status (connecting, closed) is now shown in
|
||||
`mode-line-process'.
|
||||
|
||||
** Customization of ERC variables has been made easier. Variables
|
||||
have been split into more groups for better organization.
|
||||
|
||||
** New variables
|
||||
|
||||
o `erc-send-whitespace-lines' - Set this to send lines even if they
|
||||
are empty.
|
||||
|
||||
o `erc-manual-set-nick-on-bad-nick-p' - If the nickname you chose is
|
||||
already taken or not allowed, your nick is not changed and you can
|
||||
try again manually if this is non-nil.
|
||||
|
||||
o `erc-mode-line-away-status-format' - You can now set what is shown
|
||||
in the mode-line when you are away.
|
||||
|
||||
o `erc-header-line-uses-help-echo-p' - The header-line now uses the
|
||||
help-echo property. You can set this to nil to disable it.
|
||||
|
||||
o `erc-format-query-as-channel-p' - Set this to nil to have messages
|
||||
in the query buffer formatted like private messages.
|
||||
|
||||
o `erc-show-channel-key-p' - The channel key is now shown with the
|
||||
other channel modes in the header line. Set this to nil if you
|
||||
want it hidden.
|
||||
|
||||
o `erc-prompt-for-channel-key' - Set this if you want to be prompted
|
||||
for the channel key (channel's mode is +k) when you call
|
||||
`erc-join-channel' interactively.
|
||||
|
||||
o `erc-kill-server-buffer-on-quit' - If non-nil, kill the server
|
||||
buffer automatically when you quit.
|
||||
|
||||
** New hooks
|
||||
|
||||
o `erc-join-hook' - Called when you join a channel.
|
||||
|
||||
o `erc-kick-hook' - Called when you are kicked from a channel. The
|
||||
channel's buffer is sent as an argument to functions called from
|
||||
this hook.
|
||||
|
||||
o `erc-nick-changed-functions' - Whenever your nickname changes
|
||||
successfully, the functions in this hook are run with the
|
||||
arguments NEW-NICK and OLD-NICK.
|
||||
|
||||
** New command /WHOAMI - Do a /WHOIS on your current nickname.
|
||||
|
||||
** The key binding for changing channel modes is now C-c C-o.
|
||||
|
||||
** Removed variables
|
||||
|
||||
o `erc-echo-notices-in-minibuffer-flag' and
|
||||
`erc-echo-notices-in-current-buffer' - You should use
|
||||
`erc-echo-notice-hook' and `erc-echo-notice-always-hook' instead.
|
||||
|
||||
o `erc-prompt-interactive-input' has been removed (commented out)
|
||||
because nickname completion does not work with it.
|
||||
|
||||
o All INFO buffer-related variables and functions have been removed.
|
||||
|
||||
** You can now disable modules by setting `erc-modules' with the
|
||||
customization interface.
|
||||
|
||||
** Changes and additions to modules
|
||||
|
||||
*** Autoaway (erc-autoaway.el)
|
||||
|
||||
**** New variable `erc-autoaway-no-auto-back-regexp' - Add text which,
|
||||
when you type anything matching it, will not automatically discard
|
||||
your away status when `erc-auto-discard-away' is non-nil.
|
||||
|
||||
*** Filling (erc-fill.el)
|
||||
|
||||
**** New variable `erc-fill-variable-maximum-indentation' - Don't
|
||||
indent more than this many characters when indenting a message from a
|
||||
user with a long nickname.
|
||||
|
||||
*** Goodies (erc-goodies.el)
|
||||
|
||||
**** Miscellaneous small modules have been moved from erc.el.
|
||||
The functions erc-add-scroll-to-bottom, erc-make-read-only,
|
||||
erc-send-distinguish-noncommands, erc-interpret-controls, erc-unmorse,
|
||||
erc-smiley, and erc-occur, which were defined in the main erc.el file
|
||||
have been moved to erc-goodies.el and have mostly been translated to
|
||||
the modules scrolltobottom, readonly, noncommands, irccontrols, smiley
|
||||
and unmorse.
|
||||
|
||||
**** New variables
|
||||
|
||||
o `erc-input-line-position' - The line number to use with
|
||||
`erc-scroll-to-bottom'.
|
||||
|
||||
o `erc-beep-p' - Beep if there is a \C-g control character in a
|
||||
message.
|
||||
|
||||
*** Channel lists (erc-list.el)
|
||||
|
||||
**** New variable `erc-chanlist-highlight-face' - A face used for
|
||||
highlighting the current line.
|
||||
|
||||
*** Highlighting (erc-match.el)
|
||||
|
||||
**** `erc-current-nick-highlight-type' has new options: 'keyword and
|
||||
'nick-or-keyword.
|
||||
|
||||
*** Menu (erc-menu.el)
|
||||
|
||||
**** The `IRC' menu is now automatically added to `erc-mode' buffers.
|
||||
|
||||
*** Networks (erc-nets.el)
|
||||
|
||||
**** The functions for determining current network are in this file.
|
||||
There were a couple of functions spread about in different files which
|
||||
each had a different way of determining the current network. The
|
||||
methods have been combined, and the big list of known networks
|
||||
(`erc-networks-alist') is being put to use. You can access the
|
||||
network's name by calling the new function `erc-network'. This
|
||||
returns the name of the current network as a symbol or 'Unknown if it
|
||||
could not determine which network it is.
|
||||
|
||||
*** Nicklist (erc-nicklist.el)
|
||||
|
||||
**** ERC has a new way of displaying nicknames in a channel.
|
||||
The new file erc-nicklist.el defines a new command `erc-nicklist'
|
||||
which pops up a small Emacs window showing the nicknames of all
|
||||
members of the current channel. The implementation is not complete
|
||||
and is rather proof-of-concept for now. The result is something a bit
|
||||
like erc-speedbar, but not quite as invasive, and doesn't require use
|
||||
of a new frame.
|
||||
|
||||
*** Internet services / Nickserv (erc-nickserv.el)
|
||||
|
||||
**** Network detection is now taken care of by erc-nets.el.
|
||||
The function `erc-current-network' is deprecated, use `erc-network'
|
||||
instead. The variable `erc-networks' has been removed, use
|
||||
`erc-networks-alist'. The network symbols used in
|
||||
`erc-nickserv-alist' now match those in `erc-networks-alist'.
|
||||
|
||||
**** New variable `erc-nickserv-identify-mode' - Choose which method
|
||||
to use for automatic identification: you can wait for Nickserv to ask
|
||||
you to identify (the default), or send an identify message
|
||||
automatically after you change your nickname.
|
||||
|
||||
*** Speedbar (erc-speedbar.el)
|
||||
|
||||
**** New variable `erc-speedbar-sort-users-type' - Sort users in a
|
||||
channel by activity, alphabetically, or not at all.
|
||||
|
||||
*** Timestamps (erc-stamp.el)
|
||||
|
||||
**** `erc-timestamp-only-if-changed-flag' now works when
|
||||
`erc-insert-timestamp-function' is set to 'erc-insert-timestamp-left.
|
||||
|
||||
**** New variable `erc-timestamp-intangible' - Set this to nil if
|
||||
timestamps should not have the 'intangible property.
|
||||
|
||||
*** Channel tracking (erc-track.el)
|
||||
|
||||
**** Using faces to indicate channel activity in the modeline now works
|
||||
in XEmacs.
|
||||
|
||||
**** New variables
|
||||
|
||||
o `erc-track-priority-faces-only' - Ignore changes in a channel
|
||||
unless there is a face from the `erc-track-faces-priority-list' in
|
||||
the message.
|
||||
|
||||
o `erc-track-exclude-server-buffer' - Ignore changes in the server
|
||||
buffer.
|
||||
|
||||
o `erc-track-position-in-mode-line' - Set the position in the
|
||||
mode-line where modified channels are shown (only works in GNU
|
||||
Emacs versions above 21.3).
|
||||
|
||||
* Changes since ERC 3.0.cvs.20030119
|
||||
|
||||
** The module system has again changed a lot. You can now customize
|
||||
the variable `erc-modules' and define once and for all which
|
||||
extension modules you want to use. This unfortunately may require
|
||||
you to change your current erc initialisation code a bit, if you
|
||||
have some existing customsations. On the other hand, this change
|
||||
makes the configuration of extension modules a lot easier for new
|
||||
users. In theory, you should be able to configure all aspects of
|
||||
ERC by using the customize interface, you should no longer really
|
||||
need to write Lisp code for trivial customizations.
|
||||
|
||||
By default, the following modules are now loaded: (pcomplete
|
||||
netsplit fill track ring button autojoin)
|
||||
|
||||
Please use M-x customize-variable RET erc-modules RET to change the
|
||||
default if it does not suite your needs.
|
||||
|
||||
** THe symbol used in `erc-nickserv-passwords' for debian.org IRC servers
|
||||
(formerly called OpenProjects, now FreeNode) has changed from
|
||||
openprojects to freenode. You may need to update your configuration
|
||||
for a successful automatic nickserv identification.
|
||||
|
||||
* Changes since ERC 2.93.cvs.20020819
|
||||
|
||||
** New module erc-dcc:
|
||||
|
||||
This finally implements DCC. It requires server sockets to fully work
|
||||
in both directions. This feature is currently only available in Emacs
|
||||
21.3.50 (CVS). Here is a short list of what should work though.
|
||||
|
||||
** Compatibility:
|
||||
* Emacs 21.2, DCC get, and accepting DCC chat offers.
|
||||
* XEmacs 21, Only accepting DCC chat offers.
|
||||
|
||||
** erc is switching to global-minor-modes for activation of submodules.
|
||||
|
||||
This allows you to customize such a mode and get automatic loading of
|
||||
the module. No longer putting a lot of require statments in .emacs.
|
||||
At least this is the long-term plan, not all modules are converted
|
||||
yet.
|
||||
|
||||
** The most important user visible change is that you now need to activate
|
||||
erc-completion-mode, to get TAB completion. The new completion code
|
||||
is based on pcomplete. To get the old code, manually load
|
||||
erc-complete and bind TAB to erc-complete in erc-mode-map.
|
||||
|
||||
To activate completion on startup, put (erc-completion-mode 1) in your
|
||||
.emacs file.
|
||||
|
||||
Same applies to timestamps. You no longer need to (require
|
||||
'erc-stamp), you can customize the variable `erc-timestamp-mode', and
|
||||
the rest should be automatic.
|
||||
|
||||
arch-tag: 2b21b387-6cdc-4192-889c-6743cfffdcb1
|
||||
22
etc/NEWS
22
etc/NEWS
|
|
@ -1447,9 +1447,10 @@ the next/previous matching line found by M-x occur.
|
|||
+++
|
||||
*** The new command `multi-occur' is just like `occur', except it can
|
||||
search multiple buffers. There is also a new command
|
||||
`multi-occur-by-filename-regexp' which allows you to specify the
|
||||
buffers to search by their filename. Internally, Occur mode has been
|
||||
rewritten, and now uses font-lock, among other changes.
|
||||
`multi-occur-in-matching-buffers' which allows you to specify the
|
||||
buffers to search by their filenames or buffer names. Internally,
|
||||
Occur mode has been rewritten, and now uses font-lock, among other
|
||||
changes.
|
||||
|
||||
** Grep changes:
|
||||
|
||||
|
|
@ -1536,8 +1537,8 @@ amount of text shown any more (only a crude approximation of it).
|
|||
** Xterm support:
|
||||
|
||||
---
|
||||
*** Emacs now responds to mouse-clicks on the mode-line, header-line and
|
||||
display margin, when run in an xterm.
|
||||
*** If you enable Xterm Mouse mode, Emacs will respond to mouse clicks
|
||||
on the mode line, header line and display margin, when run in an xterm.
|
||||
|
||||
---
|
||||
*** Improved key bindings support when running in an xterm.
|
||||
|
|
@ -1579,6 +1580,17 @@ colors as on X.
|
|||
|
||||
* New Modes and Packages in Emacs 22.1
|
||||
|
||||
** ERC is now part of the Emacs distribution.
|
||||
|
||||
ERC is a powerful, modular, and extensible IRC client for Emacs.
|
||||
|
||||
To see what modules are available, type
|
||||
M-x customize-option erc-modules RET.
|
||||
|
||||
To start an IRC session, type M-x erc-select, and follow the prompts
|
||||
for server, port, and nick.
|
||||
|
||||
---
|
||||
** Rcirc is now part of the Emacs distribution.
|
||||
|
||||
Rcirc is an Internet relay chat (IRC) client. It supports
|
||||
|
|
|
|||
9
etc/TODO
9
etc/TODO
|
|
@ -58,6 +58,8 @@ to the FSF.
|
|||
|
||||
** Modify allout.el to use overlays, like outline.el.
|
||||
|
||||
** M-! M-n should fetch the buffer-file-name as the default.
|
||||
|
||||
* Important features:
|
||||
|
||||
** Provide user-friendly ways to list all available font families,
|
||||
|
|
@ -442,6 +444,13 @@ when the body only calls primitives.
|
|||
For use by sml-mode, python-mode, tex-mode, scheme-mode, lisp-mode,
|
||||
haskell-mode, tuareg-mode, ...
|
||||
|
||||
** Make SYNC_INPUT the default.
|
||||
All loops using immediate_quit need to be checked to ensure that
|
||||
C-g can interrupt them, in case of an infinite loop. Once we
|
||||
switch to using SYNC_INPUT, we can remove the BLOCK_INPUTs in the
|
||||
allocation functions (allocate_string etc.) without worrying about
|
||||
data munging.
|
||||
|
||||
* Other known bugs:
|
||||
|
||||
** a two-char comment-starter whose two chars are symbol constituents will
|
||||
|
|
|
|||
59
info/dir
59
info/dir
|
|
@ -20,51 +20,54 @@ The Info Directory
|
|||
|
||||
* Menu:
|
||||
|
||||
* Info: (info). How to use the documentation browsing system.
|
||||
* Info: (info). How to use the documentation browsing system.
|
||||
|
||||
Emacs
|
||||
* Emacs: (emacs). The extensible self-documenting text editor.
|
||||
* Emacs FAQ: (efaq). Frequently Asked Questions about Emacs.
|
||||
* Emacs: (emacs). The extensible self-documenting text editor.
|
||||
* Emacs FAQ: (efaq). Frequently Asked Questions about Emacs.
|
||||
* Emacs Lisp Introduction: (eintr).
|
||||
A simple introduction to Emacs Lisp programming.
|
||||
* Elisp: (elisp). The Emacs Lisp Reference Manual.
|
||||
A simple introduction to Emacs Lisp programming.
|
||||
* Elisp: (elisp). The Emacs Lisp Reference Manual.
|
||||
|
||||
* CL: (cl). Partial Common Lisp support for Emacs Lisp.
|
||||
* CL: (cl). Partial Common Lisp support for Emacs Lisp.
|
||||
* Dired-X: (dired-x). Dired Extra Features.
|
||||
* Ediff: (ediff). A visual interface for comparing and merging programs.
|
||||
* Ediff: (ediff). A visual interface for comparing and merging programs.
|
||||
* Emacs-Xtra: (emacs-xtra). Specialized Emacs features.
|
||||
* Org Mode: (org). Outline-based notes management and organizer.
|
||||
* PCL-CVS: (pcl-cvs). Emacs front-end to CVS.
|
||||
* Speedbar: (speedbar). File/Tag summarizing utility.
|
||||
* Org Mode: (org). Outline-based notes management and organizer.
|
||||
* PCL-CVS: (pcl-cvs). Emacs front-end to CVS.
|
||||
* Speedbar: (speedbar). File/Tag summarizing utility.
|
||||
|
||||
* Ada mode: (ada-mode). Emacs mode for editing Ada code.
|
||||
* CC mode: (ccmode). Emacs mode for editing C, C++, Objective-C,
|
||||
Java, Pike, and IDL code.
|
||||
* Ebrowse: (ebrowse). A C++ class browser for Emacs.
|
||||
* CC mode: (ccmode). Emacs mode for editing C, C++, Objective-C,
|
||||
Java, Pike, and IDL code.
|
||||
* Ebrowse: (ebrowse). A C++ class browser for Emacs.
|
||||
* ERC: (erc). Powerful, modular, and extensible IRC client
|
||||
for Emacs.
|
||||
* Flymake: (flymake). An on-the-fly syntax checker for Emacs.
|
||||
* IDLWAVE: (idlwave). Major mode and shell for IDL and WAVE/CL files.
|
||||
* IDLWAVE: (idlwave). Major mode and shell for IDL and WAVE/CL files.
|
||||
|
||||
* Gnus: (gnus). The news reader Gnus.
|
||||
* Message: (message). Mail and news composition mode that goes with Gnus.
|
||||
* MH-E: (mh-e). Emacs interface to the MH mail system.
|
||||
* Gnus: (gnus). The news reader Gnus.
|
||||
* Message: (message). Mail and news composition mode that goes with Gnus.
|
||||
* MH-E: (mh-e). Emacs interface to the MH mail system.
|
||||
* MIME: (emacs-mime). Emacs MIME de/composition library.
|
||||
* Newsticker: (newsticker). A News ticker for Emacs.
|
||||
* PGG: (pgg). Emacs interface to various PGP implementations.
|
||||
* SC: (sc). Supercite lets you cite parts of messages you're
|
||||
replying to, in flexible ways.
|
||||
* PGG: (pgg). Emacs interface to various PGP implementations.
|
||||
* Rcirc: (rcirc). Internet Relay Chat (IRC) client.
|
||||
* SC: (sc). Supercite lets you cite parts of messages you're
|
||||
replying to, in flexible ways.
|
||||
* SMTP: (smtpmail). Emacs library for sending mail via SMTP.
|
||||
* Sieve: (sieve). Managing Sieve scripts in Emacs.
|
||||
|
||||
* Autotype: (autotype). Convenient features for text that you enter frequently
|
||||
in Emacs.
|
||||
* Calc: (calc). Advanced desk calculator and mathematical tool.
|
||||
* Eshell: (eshell). A command shell implemented in Emacs Lisp.
|
||||
* EUDC: (eudc). An Emacs client for directory servers (LDAP, PH).
|
||||
* Forms: (forms). Emacs package for editing data bases
|
||||
by filling in forms.
|
||||
* RefTeX: (reftex). Emacs support for LaTeX cross-references and citations.
|
||||
* Calc: (calc). Advanced desk calculator and mathematical tool.
|
||||
* Eshell: (eshell). A command shell implemented in Emacs Lisp.
|
||||
* EUDC: (eudc). An Emacs client for directory servers (LDAP, PH).
|
||||
* Forms: (forms). Emacs package for editing data bases
|
||||
by filling in forms.
|
||||
* RefTeX: (reftex). Emacs support for LaTeX cross-references and citations.
|
||||
* SES: (ses). Simple Emacs Spreadsheet
|
||||
* Tramp: (tramp). Transparent Remote (file) Access, Multiple Protocol.
|
||||
* Tramp: (tramp). Transparent Remote (file) Access, Multiple Protocol.
|
||||
Edit remote files via a remote shell (rsh,
|
||||
ssh, telnet).
|
||||
* URL: (url). URL loading package.
|
||||
|
|
@ -75,4 +78,4 @@ Emacs
|
|||
* VIPER: (viper). The newest Emacs VI-emulation mode.
|
||||
(also, A VI Plan for Emacs Rescue
|
||||
or the VI PERil.)
|
||||
* VIP: (vip). An older VI-emulation for Emacs.
|
||||
* VIP: (vip). An older VI-emulation for Emacs.
|
||||
|
|
|
|||
192
lisp/ChangeLog
192
lisp/ChangeLog
|
|
@ -1,3 +1,189 @@
|
|||
2006-01-31 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* replace.el (multi-occur): Doc fix.
|
||||
(multi-occur-in-matching-buffers): Renamed from
|
||||
multi-occur-by-filename-regexp. Prefix arg says match
|
||||
buffer names instead of file names.
|
||||
|
||||
2006-01-31 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* bs.el: Allow non-default values of `bs-header-lines-length'.
|
||||
(bs--running-in-xemacs): Remove (not needed anymore).
|
||||
(bs--set-window-height): Simplify by using `fit-window-to-buffer'
|
||||
instead of `shrink-window', thus avoiding having to compute the
|
||||
height of the window.
|
||||
(bs--up): Wrap around even when there's no header.
|
||||
(bs--down): Use `forward-line' instead of `next-line'.
|
||||
|
||||
2006-01-30 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* image-mode.el (image-toggle-display): Use file name if possible,
|
||||
instead of unnecessarily allocating a (possibly huge) lisp string.
|
||||
|
||||
2006-01-30 John Paul Wallington <jpw@pobox.com>
|
||||
|
||||
* subr.el (toplevel): Define `cl-assertion-failed' condition here
|
||||
because the `assert' macro signals it at runtime.
|
||||
|
||||
* emacs-lisp/cl.el (toplevel): Remove definition of
|
||||
`cl-assertion-failed' condition.
|
||||
|
||||
2006-01-30 Nick Roberts <nickrob@snap.net.nz>
|
||||
|
||||
* thumbs.el (thumbs-marked-list): Make buffer-local and
|
||||
permanent-local.
|
||||
(thumbs-insert-thumb): Make help-echo non-sticky.
|
||||
(thumbs-file-alist): Use eolp as check for (non)-image.
|
||||
|
||||
2006-01-30 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* ediff-mult.el (ediff-meta-buffer-keymap-setup-hook)
|
||||
(ediff-before-session-group-setup-hooks)
|
||||
(ediff-default-filtering-regexp, ediff-meta-mark-equal-files):
|
||||
Fix typos in docstrings.
|
||||
|
||||
* window.el (bw-dir, bw-eqdir, balance-windows)
|
||||
(split-window-keep-point): Fix typos in docstrings.
|
||||
|
||||
* textmodes/org.el (org-allow-space-in-links, org-closed-string)
|
||||
(org-quote-string, org-calendar-to-agenda-key)
|
||||
(org-agenda-sorting-strategy, org-agenda-use-time-grid)
|
||||
(org-show-following-heading, org-tags-column)
|
||||
(org-use-tag-inheritance, org, org-allow-space-in-links)
|
||||
(org-usenet-links-prefer-google, org-file-apps-defaults-gnu)
|
||||
(org-enable-table-editor, org-calc-default-modes)
|
||||
(org-table-allow-automatic-line-recalculation)
|
||||
(org-export-html-style, org-export-with-fixed-width)
|
||||
(org-export-with-sub-superscripts, org-special-keyword)
|
||||
(org-formula, org-time-grid, org-table-may-need-update)
|
||||
(org-mode, org-goto-ret, org-goto-left, org-goto-right)
|
||||
(org-goto-quit, org-get-indentation, org-end-of-item)
|
||||
(org-move-item-down, org-move-item-up)
|
||||
(org-renumber-ordered-list, org-todo, org-log-done, org-occur)
|
||||
(org-remove-occur-highlights, org-read-date, org-goto-calendar)
|
||||
(org-agenda, org-agenda-day-view, org-agenda-previous-date-line)
|
||||
(org-agenda-log-mode, org-agenda-toggle-diary)
|
||||
(org-agenda-toggle-time-grid, org-agenda-cleanup-fancy-diary)
|
||||
(org-agenda-file-to-end, org-agenda-no-heading-message)
|
||||
(org-agenda-get-closed, org-format-agenda-item)
|
||||
(org-cmp-priority, org-cmp-category, org-cmp-time)
|
||||
(org-agenda-change-all-lines, org-agenda-diary-entry)
|
||||
(org-scan-tags, org-after-todo-state-change-hook, org-tags-view)
|
||||
(org-link-search, org-camel-to-words, org-open-file)
|
||||
(org-remember-handler, org-table-convert-region)
|
||||
(org-table-move-row-down, org-table-move-row-up)
|
||||
(org-table-copy-region, org-table-wrap-region)
|
||||
(org-table-toggle-vline-visibility)
|
||||
(org-table-get-vertical-vector, org-table-modify-formulas)
|
||||
(org-table-get-specials, org-recalc-commands)
|
||||
(org-table-rotate-recalc-marks, org-table-eval-formula)
|
||||
(orgtbl-make-binding, org-in-invisibility-spec-p, org-cycle)
|
||||
(org-level-color-stars-only, org-insert-heading):
|
||||
Fix typos in docstrings.
|
||||
(last-arg): Add defvar.
|
||||
|
||||
* makefile.w32-in (WINS): Add erc.
|
||||
(MH_E_SRC): Update (copied from lisp/Makefile.in).
|
||||
|
||||
2006-01-29 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* Makefile.in (MH_E_SRC): Add mh-compat.el, mh-folder.el,
|
||||
mh-letter.el, mh-limit.el, mh-scan.el, mh-show.el, mh-thread.el,
|
||||
mh-tool-bar.el, mh-xface.el. Remove mh-customize.el, mh-init.el.
|
||||
(mh-autoloads): Don't use comments on otherwise empty lines.
|
||||
|
||||
2006-01-29 Edward O'Connor <ted@oconnor.cx>
|
||||
|
||||
* emulation/viper.el (viper-major-mode-modifier-list): Add
|
||||
insert-state and vi-state entries for erc-mode.
|
||||
(viper-go-away, viper-set-hooks): Add and remove
|
||||
viper-comint-mode-hook from erc-mode-hook as appropriate.
|
||||
|
||||
* emulation/viper.el (viper-insert-state-mode-list): Add erc-mode.
|
||||
|
||||
2006-01-29 Juanma Barranquero <lekktu@gmail.com>
|
||||
|
||||
* bs.el (bs--format-aux): Implement `middle' alignment as
|
||||
described in the docstring for `bs-attributes-list'.
|
||||
(bs--get-name): Simplify. Don't pad the buffer name.
|
||||
|
||||
2006-01-27 Agustin Martin <agustin.martin@hispalinux.es>
|
||||
|
||||
* textmodes/ispell.el (ispell-find-aspell-dictionaries): If no
|
||||
English aspell dictionary is installed, use the first entry of
|
||||
ispell-dictionary-alist-1.
|
||||
|
||||
2006-01-27 Kevin Rodgers <ihs_4664@yahoo.com>
|
||||
|
||||
* textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate):
|
||||
Doc fix.
|
||||
|
||||
2006-01-27 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* net/tramp-vc.el (vc-user-login-name): Wrap defadvice with a test
|
||||
for `process-file', in order to let it work for older Emacsen too.
|
||||
|
||||
2006-01-27 Eli Zaretskii <eliz@gnu.org>
|
||||
|
||||
* international/latexenc.el: Add a suitable `coding:' tag.
|
||||
(latexenc-find-file-coding-system): Undo last change.
|
||||
|
||||
2006-01-27 Arne J,bx(Brgensen <arne@arnested.dk>
|
||||
|
||||
* international/latexenc.el (latexenc-find-file-coding-system):
|
||||
Make sure latexenc-main-file is a regular file and is readable.
|
||||
|
||||
2006-01-27 Andre Spiegel <spiegel@gnu.org>
|
||||
|
||||
* vc-rcs.el (vc-rcs-fetch-master-state, vc-rcs-consult-headers):
|
||||
Pass FILE to vc-user-login-name.
|
||||
|
||||
* vc-sccs.el (vc-sccs-state): Pass FILE to vc-user-login-name.
|
||||
|
||||
2006-01-27 Nick Roberts <nickrob@snap.net.nz>
|
||||
|
||||
* thumbs.el (thumbs-do-thumbs-insertion): Suppress message when
|
||||
there are no more images to display.
|
||||
(thumbs-mark, thumbs-unmark): Revert change so that they move to
|
||||
the next image.
|
||||
|
||||
2006-01-26 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
* cus-edit.el (custom-mode): Doc: Use advertised-widget-backward.
|
||||
|
||||
* wid-edit.el (advertised-widget-backward): New alias.
|
||||
(widget-keymap): Use advertised-widget-backward for S-TAB.
|
||||
|
||||
* tumme.el: Correct the keywords.
|
||||
(tumme-dir-max-size): Use defvar.
|
||||
(tumme-setup-dired-keybindings, tumme-dired): Add autoload cookie.
|
||||
|
||||
* simple.el (move-beginning-of-line): Take account of fields.
|
||||
(clone-indirect-buffer-other-window): Take args like
|
||||
clone-indirect-buffer, and work like it.
|
||||
|
||||
* help-fns.el (describe-function): Don't pass `nil' as default.
|
||||
|
||||
* files.el (risky-local-variable-p): Follow var aliases.
|
||||
|
||||
* subr.el (lazy-completion-table): Doc fix.
|
||||
|
||||
* mail/rmailsum.el (rmail-make-summary-line-1): Don't set
|
||||
global binding of `line'.
|
||||
|
||||
2006-01-25 Andre Spiegel <spiegel@gnu.org>
|
||||
|
||||
* vc-hooks.el (vc-user-login-name): Rewritten to handle access via
|
||||
Tramp.
|
||||
|
||||
* vc.el (vc-default-dired-state-info): Pass FILE to
|
||||
vc-user-login-name.
|
||||
(vc-default-update-changelog): Don't use vc-user-login-name, we
|
||||
don't need it here.
|
||||
|
||||
* tramp-vc.el (vc-user-login-name): Comment out defadvice, it is
|
||||
no longer necessary.
|
||||
|
||||
2006-01-25 Kenichi Handa <handa@m17n.org>
|
||||
|
||||
* international/mule.el (decode-char): Avoid the overhead of
|
||||
|
|
@ -64,8 +250,8 @@
|
|||
|
||||
* thumbs.el (thumbs-extra-images): New variable. Make it buffer-local
|
||||
and permanent-local.
|
||||
(thumbs-max-image-number): New variable. Make it
|
||||
(thumbs-do-thumbs-insertion): Use them
|
||||
(thumbs-max-image-number): New variable.
|
||||
(thumbs-do-thumbs-insertion): Use them.
|
||||
(thumbs-per-line): Change default to 4.
|
||||
(thumbs-marked-list): Rename from thumbs-markedL.
|
||||
(thumbs-cleanup-thumbsdir, thumbs-delete-images)
|
||||
|
|
@ -1949,7 +2135,7 @@
|
|||
(hi-lock-find-patterns, hi-lock-font-lock-hook):
|
||||
Replace hi-lock-buffer-mode with hi-lock-mode.
|
||||
|
||||
2005-12-10 Kevin Rodgers <ihs_4664@ihs.com>
|
||||
2005-12-10 Kevin Rodgers <ihs_4664@yahoo.com>
|
||||
|
||||
* emacs-lisp/lisp.el (lisp-complete-symbol): Regenerate the
|
||||
completion list, even after a partial completion has been
|
||||
|
|
|
|||
|
|
@ -223,19 +223,23 @@ $(lisp)/progmodes/cc-mode.elc: \
|
|||
# the autoloads for the MH-E entry points, which are already in
|
||||
# loaddefs.el.
|
||||
MH_E_SRC = $(lisp)/mh-e/mh-acros.el $(lisp)/mh-e/mh-alias.el \
|
||||
$(lisp)/mh-e/mh-buffers.el $(lisp)/mh-e/mh-comp.el \
|
||||
$(lisp)/mh-e/mh-customize.el $(lisp)/mh-e/mh-e.el \
|
||||
$(lisp)/mh-e/mh-funcs.el $(lisp)/mh-e/mh-identity.el \
|
||||
$(lisp)/mh-e/mh-inc.el $(lisp)/mh-e/mh-init.el \
|
||||
$(lisp)/mh-e/mh-junk.el $(lisp)/mh-e/mh-mime.el \
|
||||
$(lisp)/mh-e/mh-print.el $(lisp)/mh-e/mh-search.el \
|
||||
$(lisp)/mh-e/mh-seq.el $(lisp)/mh-e/mh-speed.el \
|
||||
$(lisp)/mh-e/mh-utils.el
|
||||
$(lisp)/mh-e/mh-buffers.el $(lisp)/mh-e/mh-compat.el \
|
||||
$(lisp)/mh-e/mh-comp.el $(lisp)/mh-e/mh-e.el \
|
||||
$(lisp)/mh-e/mh-folder.el $(lisp)/mh-e/mh-funcs.el \
|
||||
$(lisp)/mh-e/mh-gnus.el $(lisp)/mh-e/mh-identity.el \
|
||||
$(lisp)/mh-e/mh-inc.el $(lisp)/mh-e/mh-junk.el \
|
||||
$(lisp)/mh-e/mh-letter.el $(lisp)/mh-e/mh-limit.el \
|
||||
$(lisp)/mh-e/mh-mime.el $(lisp)/mh-e/mh-print.el \
|
||||
$(lisp)/mh-e/mh-scan.el $(lisp)/mh-e/mh-search.el \
|
||||
$(lisp)/mh-e/mh-seq.el $(lisp)/mh-e/mh-show.el \
|
||||
$(lisp)/mh-e/mh-speed.el $(lisp)/mh-e/mh-thread.el \
|
||||
$(lisp)/mh-e/mh-tool-bar.el $(lisp)/mh-e/mh-utils.el \
|
||||
$(lisp)/mh-e/mh-xface.el
|
||||
|
||||
mh-autoloads: $(lisp)/mh-e/mh-loaddefs.el
|
||||
$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
|
||||
echo ";;; mh-loaddefs.el --- automatically extracted autoloads" > $@
|
||||
echo ";;" >> $@
|
||||
echo "" >> $@
|
||||
echo ";; Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc." >> $@
|
||||
echo ";; Author: Bill Wohler <wohler@newt.com>" >> $@
|
||||
echo ";; Keywords: mail" >> $@
|
||||
|
|
|
|||
55
lisp/bs.el
55
lisp/bs.el
|
|
@ -180,9 +180,6 @@ return a string representing the column's value."
|
|||
:group 'bs-appearance
|
||||
:type '(repeat sexp))
|
||||
|
||||
(defvar bs--running-in-xemacs (string-match "XEmacs" (emacs-version))
|
||||
"Non-nil when running under XEmacs.")
|
||||
|
||||
(defun bs--make-header-match-string ()
|
||||
"Return a regexp matching the first line of a Buffer Selection Menu buffer."
|
||||
(let ((res "^\\(")
|
||||
|
|
@ -701,12 +698,7 @@ Return nil if there is no such buffer."
|
|||
(defun bs--set-window-height ()
|
||||
"Change the height of the selected window to suit the current buffer list."
|
||||
(unless (one-window-p t)
|
||||
(shrink-window (- (window-height (selected-window))
|
||||
;; window-height in xemacs includes mode-line
|
||||
(+ (if bs--running-in-xemacs 3 1)
|
||||
bs-header-lines-length
|
||||
(min (length bs-current-list)
|
||||
bs-max-window-height))))))
|
||||
(fit-window-to-buffer (selected-window) bs-max-window-height)))
|
||||
|
||||
(defun bs--current-buffer ()
|
||||
"Return buffer on current line.
|
||||
|
|
@ -1011,13 +1003,11 @@ Uses function `vc-toggle-read-only'."
|
|||
"Move cursor vertically up one line.
|
||||
If on top of buffer list go to last line."
|
||||
(interactive "p")
|
||||
(previous-line 1)
|
||||
(if (<= (count-lines 1 (point)) (1- bs-header-lines-length))
|
||||
(progn
|
||||
(goto-char (point-max))
|
||||
(beginning-of-line)
|
||||
(recenter -1))
|
||||
(beginning-of-line)))
|
||||
(if (> (count-lines 1 (point)) bs-header-lines-length)
|
||||
(forward-line -1)
|
||||
(goto-char (point-max))
|
||||
(beginning-of-line)
|
||||
(recenter -1)))
|
||||
|
||||
(defun bs-down (arg)
|
||||
"Move cursor vertically down ARG lines in Buffer Selection Menu."
|
||||
|
|
@ -1029,10 +1019,9 @@ If on top of buffer list go to last line."
|
|||
(defun bs--down ()
|
||||
"Move cursor vertically down one line.
|
||||
If at end of buffer list go to first line."
|
||||
(let ((last (line-end-position)))
|
||||
(if (eq last (point-max))
|
||||
(goto-line (1+ bs-header-lines-length))
|
||||
(next-line 1))))
|
||||
(if (eq (line-end-position) (point-max))
|
||||
(goto-line (1+ bs-header-lines-length))
|
||||
(forward-line 1)))
|
||||
|
||||
(defun bs-visits-non-file (buffer)
|
||||
"Return t or nil whether BUFFER visits no file.
|
||||
|
|
@ -1332,17 +1321,9 @@ The name of current buffer gets additional text properties
|
|||
for mouse highlighting.
|
||||
START-BUFFER is the buffer where we started buffer selection.
|
||||
ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
|
||||
(let ((name (copy-sequence (buffer-name))))
|
||||
(add-text-properties
|
||||
0 (length name)
|
||||
'(mouse-face highlight
|
||||
help-echo
|
||||
"mouse-2: select this buffer, mouse-3: select in other frame")
|
||||
name)
|
||||
(if (< (length name) bs--name-entry-length)
|
||||
(concat name
|
||||
(make-string (- bs--name-entry-length (length name)) ? ))
|
||||
name)))
|
||||
(propertize (buffer-name)
|
||||
'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"
|
||||
'mouse-face 'highlight))
|
||||
|
||||
(defun bs--get-mode-name (start-buffer all-buffers)
|
||||
"Return the name of mode of current buffer for Buffer Selection Menu.
|
||||
|
|
@ -1399,12 +1380,12 @@ normally *buffer-selection*."
|
|||
(defun bs--format-aux (string align len)
|
||||
"Generate a string with STRING with alignment ALIGN and length LEN.
|
||||
ALIGN is one of the symbols `left', `middle', or `right'."
|
||||
(let ((length (length string)))
|
||||
(if (>= length len)
|
||||
string
|
||||
(if (eq 'right align)
|
||||
(concat (make-string (- len length) ? ) string)
|
||||
(concat string (make-string (- len length) ? ))))))
|
||||
(let* ((width (length string))
|
||||
(len (max len width)))
|
||||
(format (format "%%%s%ds" (if (eq align 'right) "" "-") len)
|
||||
(if (eq align 'middle)
|
||||
(concat (make-string (/ (- len width) 2) ?\s) string)
|
||||
string))))
|
||||
|
||||
(defun bs--show-header ()
|
||||
"Insert header for Buffer Selection Menu in current buffer."
|
||||
|
|
|
|||
|
|
@ -4417,7 +4417,7 @@ The following commands are available:
|
|||
|
||||
\\<widget-keymap>\
|
||||
Move to next button, link or editable field. \\[widget-forward]
|
||||
Move to previous button, link or editable field. \\[widget-backward]
|
||||
Move to previous button, link or editable field. \\[advertised-widget-backward]
|
||||
\\<custom-field-keymap>\
|
||||
Complete content of editable text field. \\[widget-complete]
|
||||
\\<custom-mode-map>\
|
||||
|
|
|
|||
|
|
@ -176,7 +176,7 @@ directories.")
|
|||
|
||||
(defcustom ediff-default-filtering-regexp nil
|
||||
"The default regular expression used as a filename filter in multifile comparisons.
|
||||
Should be a sexp. For instance (car ediff-filtering-regexp-history) or nil."
|
||||
Should be a sexp. For instance (car ediff-filtering-regexp-history) or nil."
|
||||
:type 'sexp
|
||||
:group 'ediff-mult)
|
||||
|
||||
|
|
@ -219,9 +219,9 @@ This can be toggled with `ediff-toggle-filename-truncation'."
|
|||
|
||||
(defcustom ediff-before-session-group-setup-hooks nil
|
||||
"*Hooks to run before Ediff arranges the window for group-level operations.
|
||||
It is used by commands such as ediff-directories.
|
||||
It is used by commands such as `ediff-directories'.
|
||||
This hook can be used to save the previous window config, which can be restored
|
||||
on ediff-quit, ediff-suspend, or ediff-quit-session-group-hook."
|
||||
on `ediff-quit', `ediff-suspend', or `ediff-quit-session-group-hook'."
|
||||
:type 'hook
|
||||
:group 'ediff-hook)
|
||||
(defcustom ediff-after-session-group-setup-hook nil
|
||||
|
|
@ -242,7 +242,7 @@ ediff-directories, is run."
|
|||
:type 'hook
|
||||
:group 'ediff-mult)
|
||||
(defcustom ediff-meta-buffer-keymap-setup-hook nil
|
||||
"*Hooks run just after setting up the ediff-meta-buffer-map.
|
||||
"*Hooks run just after setting up the `ediff-meta-buffer-map'.
|
||||
This keymap controls key bindings in the meta buffer and is a local variable.
|
||||
This means that you can set different bindings for different kinds of meta
|
||||
buffers."
|
||||
|
|
@ -363,7 +363,7 @@ buffers."
|
|||
(file-directory-p (ediff-get-session-objC-name session-info)) t)))
|
||||
|
||||
;; set up the keymap in the meta buffer
|
||||
(defun ediff-setup-meta-map()
|
||||
(defun ediff-setup-meta-map ()
|
||||
(setq ediff-meta-buffer-map (make-sparse-keymap))
|
||||
(suppress-keymap ediff-meta-buffer-map)
|
||||
(define-key ediff-meta-buffer-map "q" 'ediff-quit-meta-buffer)
|
||||
|
|
@ -2332,8 +2332,8 @@ If this is a session registry buffer then just bury it."
|
|||
"Run through the session list and mark identical files.
|
||||
This is used only for sessions that involve 2 or 3 files at the same time.
|
||||
ACTION is an optional argument that can be ?h, ?m, ?=, to mark for hiding, mark
|
||||
for operation, or simply indicate which are equal files. If it is nil, then
|
||||
last-command-char is used to decide which action to take."
|
||||
for operation, or simply indicate which are equal files. If it is nil, then
|
||||
`last-command-char' is used to decide which action to take."
|
||||
(interactive)
|
||||
(if (null action)
|
||||
(setq action last-command-char))
|
||||
|
|
|
|||
|
|
@ -580,9 +580,6 @@ If ALIST is non-nil, the new pairs are prepended to it."
|
|||
|
||||
;;; Miscellaneous.
|
||||
|
||||
(put 'cl-assertion-failed 'error-conditions '(error))
|
||||
(put 'cl-assertion-failed 'error-message "Assertion failed")
|
||||
|
||||
(defvar cl-fake-autoloads nil
|
||||
"Non-nil means don't make CL functions autoload.")
|
||||
|
||||
|
|
|
|||
|
|
@ -458,6 +458,7 @@ unless it is coming up in a wrong Viper state."
|
|||
'(internal-ange-ftp-mode
|
||||
comint-mode
|
||||
inferior-emacs-lisp-mode
|
||||
erc-mode
|
||||
eshell-mode
|
||||
shell-mode)
|
||||
"*A list of major modes that should come up in Vi Insert state."
|
||||
|
|
@ -494,6 +495,8 @@ unless it is coming up in a wrong Viper state."
|
|||
(gnus-summary-mode emacs-state viper-gnus-modifier-map)
|
||||
(Info-mode emacs-state viper-slash-and-colon-map)
|
||||
(Buffer-menu-mode emacs-state viper-slash-and-colon-map)
|
||||
(erc-mode insert-state viper-comint-mode-modifier-map)
|
||||
(erc-mode vi-state viper-comint-mode-modifier-map)
|
||||
)
|
||||
"List specifying how to modify the various major modes to enable some Viperisms.
|
||||
The list has the structure: ((mode viper-state keymap) (mode viper-state
|
||||
|
|
@ -768,6 +771,7 @@ It also can't undo some Viper settings."
|
|||
;; remove all hooks set by viper
|
||||
(mapatoms 'viper-remove-hooks)
|
||||
(remove-hook 'comint-mode-hook 'viper-comint-mode-hook)
|
||||
(remove-hook 'erc-mode-hook 'viper-comint-mode-hook)
|
||||
(remove-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel)
|
||||
(remove-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel)
|
||||
(remove-hook 'post-command-hook 'viper-minibuffer-post-command-hook)
|
||||
|
|
@ -913,6 +917,7 @@ It also can't undo some Viper settings."
|
|||
|
||||
;; Emacs shell, ange-ftp, and comint-based modes
|
||||
(add-hook 'comint-mode-hook 'viper-comint-mode-hook) ; comint
|
||||
(add-hook 'erc-mode-hook 'viper-comint-mode-hook) ; ERC
|
||||
|
||||
(add-hook 'eshell-mode-hook
|
||||
(lambda () (setq viper-auto-indent nil)))
|
||||
|
|
|
|||
3
lisp/erc/.gitignore
vendored
Normal file
3
lisp/erc/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
{arch}
|
||||
.arch-ids
|
||||
*.elc
|
||||
371
lisp/erc/ChangeLog
Normal file
371
lisp/erc/ChangeLog
Normal file
|
|
@ -0,0 +1,371 @@
|
|||
2006-01-30 Simon Josefsson <jas@extundo.com>
|
||||
|
||||
* erc.el (erc-open-ssl-stream): Use tls.el.
|
||||
|
||||
2006-01-30 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* erc-stamp.el (erc-timestamp-right-align-by-pixel): New option
|
||||
that determines whether to use pixel values to align right
|
||||
timestamps. The default is not to do so, since it only works with
|
||||
Emacs22 on X, and even then some people have trouble.
|
||||
(erc-insert-aligned): Use `erc-timestamp-right-align-by-pixel'.
|
||||
|
||||
2006-01-29 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* ChangeLog, ChangeLog.2005, ChangeLog.2004, ChangeLog.2003,
|
||||
ChangeLog.2002, ChangeLog.2001: Add "See ChangeLog.NNNN" line for
|
||||
earlier changes. Use utf-8 encoding. Fix some accent typos.
|
||||
|
||||
* erc-speedbar.el (erc-speedbar-buttons): Fix reference to free
|
||||
variable.
|
||||
(erc-speedbar-goto-buffer): Fix compiler warning.
|
||||
|
||||
* erc-ibuffer.el: Use `define-ibuffer-filter' instead of
|
||||
`ibuffer-degine-limiter'. Use `define-ibuffer-column' instead of
|
||||
`ibuffer-define-column'. Require 'ibuf-ext so that the macros
|
||||
work without compiler warnings.
|
||||
|
||||
* man/erc.texi (Obtaining ERC, Installation): Note that these
|
||||
sections may be skipped if using the version of ERC that comes
|
||||
with Emacs.
|
||||
|
||||
2006-01-29 Edward O'Connor <ted@oconnor.cx>
|
||||
|
||||
* erc-viper.el: Remove. Now that ERC is included in Emacs, these
|
||||
work-arounds live in Viper itself.
|
||||
|
||||
2006-01-28 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* erc-*.el, erc.texi, NEWS: Add Arch taglines as per Emacs
|
||||
guidelines.
|
||||
|
||||
* erc-*.el: Space out copyright years like the rest of Emacs. Use
|
||||
the Emacs copyright statement. Refer to ourselves as ERC rather
|
||||
than "Emacs IRC Client", since there are now several IRC clients
|
||||
for Emacs.
|
||||
|
||||
* erc-compat.el (erc-emacs-build-time): Define as a variable.
|
||||
|
||||
* erc-log.el (erc-log-setup-logging): Use write-file-functions.
|
||||
|
||||
* erc-ibuffer.el: Require 'erc.
|
||||
|
||||
* erc-stamp.el (erc-insert-aligned): Only use the special text
|
||||
property when window-system is X.
|
||||
|
||||
* erc.texi: Adapt for inclusion in Emacs.
|
||||
|
||||
2006-01-28 Johan Bockgård <bojohan@users.sourceforge.net>
|
||||
|
||||
* erc.el (erc-format-message): More `cl' breakage; don't use
|
||||
`oddp'.
|
||||
|
||||
2006-01-27 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* debian/changelog: Update for new release.
|
||||
|
||||
* debian/control (Description): Update.
|
||||
|
||||
* debian/rules: Concatenate ChangeLog for 2005.
|
||||
|
||||
* Makefile (MISC): Include ChangeLog.2005 and erc.texi.
|
||||
(debrelease, release): Copy images directory.
|
||||
|
||||
* NEWS: Spelling fixes. Add items for recent changes.
|
||||
|
||||
* erc.el (erc): Move call to erc-update-modules before the call to
|
||||
erc-mode. This should fix a timestamp display issue.
|
||||
(erc-version-string): Release ERC 5.1.
|
||||
|
||||
2006-01-26 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* erc-stamp.el (erc-insert-aligned): New function that inserts
|
||||
text in an perfectly-aligned way relative to the right margin. It
|
||||
only works well with Emacs22. A sane fallback is provided for
|
||||
other versions of Emacs.
|
||||
(erc-insert-timestamp-right): Use the new function.
|
||||
|
||||
2006-01-25 Edward O'Connor <ted@oconnor.cx>
|
||||
|
||||
* erc.el (erc-modules): Ensure that `erc-button-mode' gets enabled
|
||||
before `erc-match-mode'.
|
||||
|
||||
* erc-match.el (match): Append `erc-match-message' to
|
||||
`erc-insert-modify-hook'.
|
||||
|
||||
2006-01-25 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* FOR-RELEASE: Mark last release requirement as done.
|
||||
|
||||
* Makefile (realclean, distclean): Remove docs.
|
||||
|
||||
* erc.texi: Take care of all pre-5.1 items.
|
||||
|
||||
* erc-backend.el (erc-server-send, erc-server-send-queue): Wrap
|
||||
`process-send-string' in `condition-case' to avoid an error when
|
||||
quitting ERC.
|
||||
|
||||
* erc-stamp.el (erc-insert-timestamp-right): Try to deal with
|
||||
variable-width characters in the timestamp and on the same line.
|
||||
The latter is a kludge, but it seems to work with most of the
|
||||
input I've thrown at it so far. It's certainly better than going
|
||||
past the end of line consistently when we have variable-width
|
||||
characters on the same line. When `erc-timestamp-intangible' is
|
||||
non-nil, add intangible properties to the whitespace as well, so
|
||||
that hitting <end> does what you'd expect.
|
||||
|
||||
* erc.el (erc-flood-protect, erc-toggle-flood-control): Update
|
||||
this to only use boolean values for `erc-flood-protect'. Update
|
||||
documentation.
|
||||
(erc-cmd-QUIT): Set the active buffer to be the server buffer, so
|
||||
that any QUIT-related messages go there.
|
||||
(erc): Try to be more clever about re-using channel buffers when
|
||||
automatically re-connecting. Thanks to e1f for noticing.
|
||||
|
||||
2006-01-23 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* ChangeLog.2005: Remove erroneous line.
|
||||
|
||||
* FOR-RELEASE: Make that the Makefile tweaking is complete.
|
||||
(NEWS): Mark as done.
|
||||
|
||||
* Makefile (MANUAL): New option indicating the name of the manual.
|
||||
(PREFIX, ELISPDIR, INFODIR): New options that specify the
|
||||
directories to install lisp code and info manuals to. PREFIX is
|
||||
used only by ELISPDIR and INFODIR.
|
||||
(all): Call `lisp' and create the manual.
|
||||
(lisp): Compile lisp code.
|
||||
(%.info, %.html): New rules that make Info files and HTML files,
|
||||
respectively, from a TexInfo source.
|
||||
(doc): Create both the Info and HTML versions of the manual. This
|
||||
is for the user -- we never call it automatically.
|
||||
(install-info): Install Info files.
|
||||
(install-bin): Install compiled and source Lisp files.
|
||||
(todo): Remove, since it seems pointless.
|
||||
|
||||
* NEWS: Update.
|
||||
|
||||
* README: Add Installation instructions. Tweak layout.
|
||||
|
||||
* erc.texi: Work on some pre-5.1 items.
|
||||
|
||||
* erc-stamp.el, erc-track.el: Move some functions and options in
|
||||
order to get rid of a few compiler warnings.
|
||||
|
||||
* erc.el (erc-modules): Enable readonly by default. This will
|
||||
prevent new users from accidentally removing old messages, which
|
||||
could be disconcerting. Also enable stamp by default, since
|
||||
timestamps are a fairly standard feature among IRC clients.
|
||||
|
||||
* erc-button.el: Munge whitespace.
|
||||
|
||||
* erc-identd.el (erc-identd-start): Instead of throwing an error,
|
||||
just try to use the obsolete function.
|
||||
|
||||
2006-01-22 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* erc-backend.el (erc-decode-string-from-target): Make sure that
|
||||
we have a string as an argument. If not, coerce it to the empty
|
||||
string. Hopefully, this will work painlessly around an edge case
|
||||
related to quitting ERC around the same time a message comes in.
|
||||
|
||||
2006-01-22 Johan Bockgård <bojohan@users.sourceforge.net>
|
||||
|
||||
* erc-track.el: Use `(eval-when-compile (require 'cl))' (for
|
||||
`case'). Doc fixes.
|
||||
(erc-find-parsed-property): Simplify.
|
||||
(erc-track-get-active-buffer): Fix logic. Simplify.
|
||||
(erc-track-switch-buffer): Remove unused variable `dir'. Simplify.
|
||||
|
||||
* erc-speak.el: Doc fixes.
|
||||
(erc-speak-region): `propertize' --> `erc-propertize'.
|
||||
|
||||
* erc-dcc.el (erc-dcc-chat-parse-output): `propertize' -->
|
||||
`erc-propertize'.
|
||||
|
||||
* erc-button.el (erc-button-add-button): Take erc-fill-prefix into
|
||||
account when wrapping URLs.
|
||||
|
||||
* erc-bbdb.el (erc-bbdb-elide-display): Doc fix.
|
||||
|
||||
* erc-backend.el (define-erc-response-handler): Doc fix.
|
||||
|
||||
2006-01-22 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* erc.el (erc-update-modules): Use `require' instead of `load',
|
||||
but prevent it from causing errors, in order to preserve the
|
||||
previous behavior.
|
||||
|
||||
2006-01-21 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* FOR-RELEASE (Source): Mark cl task as done.
|
||||
|
||||
* Makefile (erc-auto.el): Call erc-generate-autoloads rather than
|
||||
generate-autoloads.
|
||||
(erc-auto.el, %.elc): Don't show command, just its output.
|
||||
|
||||
* NEWS: Add items from 2005-01-01 to 2005-08-13.
|
||||
|
||||
* debian/copyright (Copyright): Update.
|
||||
|
||||
* erc-auto.in (erc-generate-autoloads): Rename from
|
||||
generate-autoloads.
|
||||
|
||||
* erc.el, erc-autoaway.el, erc-backend.el: Use
|
||||
erc-server-process-alive instead of erc-process-alive.
|
||||
|
||||
* erc.el, erc-backend.el, erc-ezbounce.el, erc-list.el,
|
||||
erc-log.el, erc-match.el, erc-nets.el, erc-netsplit.el,
|
||||
erc-nicklist.el, erc-nickserv.el, erc-notify.el, erc-pcomplete.el:
|
||||
Use (eval-when-compile (require 'cl)), so that compilation doesn't
|
||||
fail.
|
||||
|
||||
* erc-fill.el, erc-truncate.el: Whitespace munging.
|
||||
|
||||
* erc.el: Update copyright notice. Remove eval-after-load code.
|
||||
(erc-with-buffer): Docfix.
|
||||
(erc-once-with-server-event, erc-once-with-server-event-global)
|
||||
(erc-with-buffer, erc-with-all-buffers-of-server): Use erc-gensym
|
||||
instead of gensym.
|
||||
(erc-banlist-update): Use erc-delete-if instead of delete-if.
|
||||
(erc): Call `erc-update-modules' here.
|
||||
|
||||
* erc-backend.el: Require 'erc-compat to minimize compiler
|
||||
warnings.
|
||||
(erc-decode-parsed-server-response): Docfix.
|
||||
(erc-server-process-alive): Move here from erc.el and rename from
|
||||
`erc-process-alive'.
|
||||
(erc-server-send, erc-remove-channel-users): Make sure process is
|
||||
alive before sending data to it.
|
||||
|
||||
* erc-bbdb.el: Update copyright years.
|
||||
(erc-bbdb-whois): Remove overexuberant comment.
|
||||
|
||||
* erc-button.el: Require erc-fill, since we make liberal use of
|
||||
`erc-fill-column'.
|
||||
|
||||
* erc-compat.el (erc-const-expr-p, erc-list*, erc-assert): New
|
||||
functions, the latter of which provides an `assert' equivalent.
|
||||
(erc-remove-if-not): New function that provides a simple
|
||||
implementation of `remove-if-not'.
|
||||
(erc-gensym): New function that provides a simple implementation
|
||||
of `gensym'.
|
||||
(erc-delete-if): New function that provides a simple
|
||||
implementation of `delete-if'.
|
||||
(erc-member-if): New function that provides a simple
|
||||
implementation of `member-if'.
|
||||
(field-end): Remove this, since it is unused, and later versions
|
||||
of XEmacs have this function already.
|
||||
(erc-function-arglist): Moved here from erc.el.
|
||||
(erc-delete-dups): New compatibility function for dealing with
|
||||
XEmacs.
|
||||
(erc-subseq): New function copied from cl-extra.el.
|
||||
|
||||
* erc-dcc.el: Require pcomplete during compilation to avoid
|
||||
compiler warnings.
|
||||
(erc-unpack-int, erc-dcc-send-filter)
|
||||
(erc-dcc-get-filter): Use erc-assert instead of assert.
|
||||
(pcomplete/erc-mode/DCC): Use erc-remove-if-not instead of
|
||||
remove-if-not.
|
||||
|
||||
* erc-match.el (erc-log-matches): Fix compiler warning.
|
||||
|
||||
* erc-nicklist.el: Update copyright notice.
|
||||
(erc-nicklist-menu): Change use of caadr to (car (cadr ...)).
|
||||
(erc-nicklist-bitlbee-connected-p): Remove.
|
||||
(erc-nicklist-insert-medium-name-or-icon): Accept channel
|
||||
argument. Use it to determine whether we are on bitlbee. Now
|
||||
that bitlbee names its channel "&bitlbee", this is trivial.
|
||||
(erc-nicklist-insert-contents): Pass channel as specified above.
|
||||
Don't try to determine whether we are on bitlbee here.
|
||||
(erc-nicklist-channel-users-info): Use erc-remove-if-not instead
|
||||
of remove-if-not.
|
||||
(erc-nicklist-search-for-nick): Use erc-member-if instead of
|
||||
member-if.
|
||||
|
||||
* erc-notify.el (erc-notify-QUIT): Use erc-delete-if with a
|
||||
partially-evaluated lambda expression instead of `delete' and
|
||||
`find'.
|
||||
|
||||
* erc-track.el: Use erc-assert.
|
||||
(erc-track-modified-channels): Remove use of `return'.
|
||||
(erc-track-modified-channels): Use `cadr' instead of `second',
|
||||
since otherwise we would need yet another eval-when-compile line.
|
||||
|
||||
2006-01-19 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* erc-backend.el (erc-process-sentinel-1): Remove attempt to
|
||||
detect SIGPIPE, since it doesn't work.
|
||||
|
||||
2006-01-10 Diane Murray <disumu@x3y2z1.net>
|
||||
|
||||
* erc-spelling.el: Updated copyright years.
|
||||
(define-erc-module): Enable/disable `flyspell-mode' for all open
|
||||
ERC buffers as well.
|
||||
(erc-spelling-dictionaries): Reworded customize description.
|
||||
|
||||
* erc.el (erc-command-symbol): New function.
|
||||
(erc-extract-command-from-line): Use `erc-command-symbol'. This
|
||||
fixes a bug where "Symbol's function definition is void:
|
||||
erc-cmd-LIST" would be shown after typing /list at the prompt (the
|
||||
command was interned because erc-menu.el uses it and is enabled by
|
||||
default whereas erc-list.el is not).
|
||||
|
||||
* NEWS: Started a list of renamed variables.
|
||||
|
||||
* erc.el: Reworded the message sent when defining variable
|
||||
aliases.
|
||||
(erc-command-indicator-face): Doc fix.
|
||||
(erc-modules): Enable the match module by default which makes
|
||||
current nickname highlighting on as the default.
|
||||
|
||||
* erc-button.el: Updated copyright years.
|
||||
(erc-button): New face.
|
||||
(erc-button-face): Use `erc-button'.
|
||||
(erc-button-nickname-face): New customizable variable.
|
||||
(erc-button-add-nickname-buttons, erc-button-add-buttons-1): Send
|
||||
new argument to `erc-button-add-button'.
|
||||
(erc-button-add-button): Doc fix. Added new argument to function
|
||||
definition, NICK-P. If it's a nickname, use
|
||||
`erc-button-nickname-face', otherwise use `erc-button-face'. This
|
||||
makes channel tracking and buttons work better together when
|
||||
`erc-button-buttonize-nicks' is enabled, since there is a nickname
|
||||
on just about every line.
|
||||
|
||||
* erc-track.el (erc-track-use-faces): Doc fix.
|
||||
(erc-track-faces-priority-list): Added `erc-button' to list.
|
||||
(erc-track-priority-faces-only): Doc fix.
|
||||
|
||||
2006-01-09 Diane Murray <disumu@x3y2z1.net>
|
||||
|
||||
* erc-button.el (erc-button-url-regexp): Use `concat' so the
|
||||
regexp is not one long line.
|
||||
(erc-button-alist): Fixed so that customizing works correctly.
|
||||
Reorganized. Removed lambda functions with more than two lines.
|
||||
Doc fix.
|
||||
(erc-button-describe-symbol, erc-button-beats-to-time): New
|
||||
functions. Moved from `erc-button-alist'.
|
||||
|
||||
2006-01-07 Michael Olson <mwolson@gnu.org>
|
||||
|
||||
* erc-backend.el (erc-process-sentinel-1): Don't try to re-open a
|
||||
process if a SIGPIPE occurs. This happens when a new message
|
||||
comes in at the same time a /quit is requested.
|
||||
(erc-process-sentinel): Use string-match rather than string= to do
|
||||
these comparisons. Matching literal newlines makes me nervous.
|
||||
|
||||
* erc-track.el (erc-track-remove-from-mode-line): Handle case
|
||||
where global-mode-string is not a list. Emacs22 permits this.
|
||||
|
||||
|
||||
See ChangeLog.2005 for earlier changes.
|
||||
|
||||
Copyright (C) 2006 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: utf-8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 865a75f6-2bcb-46df-bf0c-b514dadf688a
|
||||
1046
lisp/erc/ChangeLog.2001
Normal file
1046
lisp/erc/ChangeLog.2001
Normal file
File diff suppressed because it is too large
Load diff
2607
lisp/erc/ChangeLog.2002
Normal file
2607
lisp/erc/ChangeLog.2002
Normal file
File diff suppressed because it is too large
Load diff
2151
lisp/erc/ChangeLog.2003
Normal file
2151
lisp/erc/ChangeLog.2003
Normal file
File diff suppressed because it is too large
Load diff
2080
lisp/erc/ChangeLog.2004
Normal file
2080
lisp/erc/ChangeLog.2004
Normal file
File diff suppressed because it is too large
Load diff
1228
lisp/erc/ChangeLog.2005
Normal file
1228
lisp/erc/ChangeLog.2005
Normal file
File diff suppressed because it is too large
Load diff
207
lisp/erc/erc-autoaway.el
Normal file
207
lisp/erc/erc-autoaway.el
Normal file
|
|
@ -0,0 +1,207 @@
|
|||
;;; erc-autoaway.el --- Provides autoaway for ERC
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jorgen Schaefer <forcer@forcix.cx>
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoAway
|
||||
|
||||
;; 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:
|
||||
|
||||
;; TODO:
|
||||
;; - Legacy names: erc-auto-discard-away, erc-auto-set-away
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
|
||||
(defgroup erc-autoaway nil
|
||||
"Set yourself automatically away after some idletime and set
|
||||
yourself back when you type something."
|
||||
:group 'erc)
|
||||
|
||||
(defvar erc-autoaway-idletimer nil
|
||||
"The Emacs idletimer.
|
||||
This is only used when `erc-autoaway-use-emacs-idle' is non-nil.")
|
||||
|
||||
(defcustom erc-autoaway-use-emacs-idle nil
|
||||
"*If non-nil, the idle time refers to idletime in Emacs.
|
||||
If nil, the idle time refers to idletime on IRC only.
|
||||
The time itself is specified by `erc-autoaway-idle-seconds'.
|
||||
See `erc-autoaway-mode' for more information on the various
|
||||
definitions of being idle.
|
||||
|
||||
Note that using Emacs idletime is currently broken for most versions,
|
||||
since process activity (as happens all the time on IRC) makes Emacs
|
||||
non-idle. Emacs idle-time and user idle-time are just not the same."
|
||||
:group 'erc-autoaway
|
||||
:type 'boolean)
|
||||
|
||||
;;;###autoload (autoload 'erc-autoaway-mode "erc-autoaway")
|
||||
(define-erc-module autoaway nil
|
||||
"In ERC autoaway mode, you can be set away automatically.
|
||||
If `erc-auto-set-away' is set, then you will be set away after
|
||||
the number of seconds specified in `erc-autoaway-idle-seconds'.
|
||||
|
||||
There are several kinds of being idle:
|
||||
|
||||
IRC idle time measures how long since you last sent something (see
|
||||
`erc-autoaway-last-sent-time'). This is the default.
|
||||
|
||||
Emacs idle time measures how long Emacs has been idle. This is
|
||||
currently not useful, since Emacs is non-idle when it handles
|
||||
ping-pong with IRC servers. See `erc-autoaway-use-emacs-idle' for
|
||||
more information.
|
||||
|
||||
User idle time measures how long you have not been sending any
|
||||
commands to Emacs, or to your system. Emacs currently provides no way
|
||||
to measure user idle time.
|
||||
|
||||
If `erc-auto-discard-away' is set, then typing anything, will
|
||||
set you no longer away.
|
||||
|
||||
Related variables: `erc-public-away-p' and `erc-away-nickname'."
|
||||
;; Enable:
|
||||
((add-hook 'erc-send-completed-hook 'erc-autoaway-reset-idletime)
|
||||
(add-hook 'erc-server-001-functions 'erc-autoaway-reset-idletime)
|
||||
(add-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away)
|
||||
(when erc-autoaway-use-emacs-idle
|
||||
(erc-autoaway-reestablish-idletimer)))
|
||||
;; Disable:
|
||||
((remove-hook 'erc-send-completed-hook 'erc-autoaway-reset-idletime)
|
||||
(remove-hook 'erc-server-001-functions 'erc-autoaway-reset-idletime)
|
||||
(remove-hook 'erc-timer-hook 'erc-autoaway-possibly-set-away)
|
||||
(when erc-autoaway-idletimer
|
||||
(erc-cancel-timer erc-autoaway-idletimer)
|
||||
(setq erc-autoaway-idletimer nil))))
|
||||
|
||||
(defcustom erc-auto-set-away t
|
||||
"*If non-nil, set away after `erc-autoaway-idle-seconds' seconds of idling.
|
||||
ERC autoaway mode can set you away when you idle, and set you no
|
||||
longer away when you type something. This variable controls whether
|
||||
you will be set away when you idle. See `erc-auto-discard-away' for
|
||||
the other half."
|
||||
:group 'erc-autoaway
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-auto-discard-away t
|
||||
"*If non-nil, sending anything when away automatically discards away state.
|
||||
ERC autoaway mode can set you away when you idle, and set you no
|
||||
longer away when you type something. This variable controls whether
|
||||
you will be set no longer away when you type something. See
|
||||
`erc-auto-set-away' for the other half.
|
||||
See also `erc-autoaway-no-auto-discard-regexp'."
|
||||
:group 'erc-autoaway
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-autoaway-no-auto-discard-regexp "^/g?away.*$"
|
||||
"*Input that matches this will not automatically discard away status.
|
||||
See `erc-auto-discard-away'."
|
||||
:group 'erc-autoaway
|
||||
:type 'regexp)
|
||||
|
||||
(eval-when-compile (defvar erc-autoaway-idle-seconds))
|
||||
|
||||
(defun erc-autoaway-reestablish-idletimer ()
|
||||
"Reestablish the emacs idletimer.
|
||||
You have to call this function each time you change
|
||||
`erc-autoaway-idle-seconds', if `erc-autoaway-use-emacs-idle' is set."
|
||||
(interactive)
|
||||
(when erc-autoaway-idletimer
|
||||
(erc-cancel-timer erc-autoaway-idletimer))
|
||||
(setq erc-autoaway-idletimer
|
||||
(run-with-idle-timer erc-autoaway-idle-seconds
|
||||
t
|
||||
'erc-autoaway-set-away
|
||||
erc-autoaway-idle-seconds)))
|
||||
|
||||
(defcustom erc-autoaway-idle-seconds 1800
|
||||
"*Number of seconds after which ERC will set you automatically away.
|
||||
If you are changing this variable using lisp instead of customizing it,
|
||||
you have to run `erc-autoaway-reestablish-idletimer' afterwards."
|
||||
:group 'erc-autoaway
|
||||
:set (lambda (sym val)
|
||||
(set-default sym val)
|
||||
(when erc-autoaway-use-emacs-idle
|
||||
(erc-autoaway-reestablish-idletimer)))
|
||||
:type 'number)
|
||||
|
||||
(defcustom erc-autoaway-message
|
||||
"I'm gone (autoaway after %i seconds of idletime)"
|
||||
"*Message ERC will use when he sets you automatically away.
|
||||
It is used as a `format' string with the argument of the idletime in
|
||||
seconds."
|
||||
:group 'erc-autoaway
|
||||
:type 'string)
|
||||
|
||||
(defvar erc-autoaway-last-sent-time (erc-current-time)
|
||||
"The last time the user sent something.")
|
||||
|
||||
(defun erc-autoaway-reset-idletime (line &rest stuff)
|
||||
"Reset the stored idletime for the user.
|
||||
This is one global variable since a user talking on one net can talk
|
||||
on another net too."
|
||||
(when (and erc-auto-discard-away
|
||||
(stringp line)
|
||||
(not (string-match erc-autoaway-no-auto-discard-regexp line)))
|
||||
(erc-autoaway-set-back line))
|
||||
(setq erc-autoaway-last-sent-time (erc-current-time)))
|
||||
|
||||
(defun erc-autoaway-set-back (line)
|
||||
"Discard the away state globally."
|
||||
(when (erc-away-p)
|
||||
(setq erc-autoaway-last-sent-time (erc-current-time))
|
||||
(erc-cmd-GAWAY "")))
|
||||
|
||||
(defun erc-autoaway-possibly-set-away (current-time)
|
||||
"Set autoaway when `erc-auto-set-away' is true and the idletime is
|
||||
exceeds `erc-autoaway-idle-seconds'."
|
||||
;; A test for (erc-server-process-alive) is not necessary, because
|
||||
;; this function is called from `erc-timer-hook', which is called
|
||||
;; whenever the server sends something to the client.
|
||||
(when (and erc-auto-set-away
|
||||
(not (erc-away-p)))
|
||||
(let ((idle-time (erc-time-diff erc-autoaway-last-sent-time
|
||||
current-time)))
|
||||
(when (>= idle-time erc-autoaway-idle-seconds)
|
||||
(erc-display-message
|
||||
nil 'notice nil
|
||||
(format "Setting automatically away after %i seconds of idle-time"
|
||||
idle-time))
|
||||
(erc-autoaway-set-away idle-time)))))
|
||||
|
||||
(defun erc-autoaway-set-away (idle-time)
|
||||
"Set the away state globally."
|
||||
;; Note that the idle timer runs, even when Emacs is inactive. In
|
||||
;; order to prevent flooding when we connect, we test for an
|
||||
;; existing process.
|
||||
(when (and (erc-server-process-alive)
|
||||
(not (erc-away-p)))
|
||||
(erc-cmd-GAWAY (format erc-autoaway-message idle-time))))
|
||||
|
||||
(provide 'erc-autoaway)
|
||||
|
||||
;;; erc-autoaway.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 16fc241e-8358-4b56-9fe2-116bdd0ba3bc
|
||||
139
lisp/erc/erc-autojoin.el
Normal file
139
lisp/erc/erc-autojoin.el
Normal file
|
|
@ -0,0 +1,139 @@
|
|||
;;; erc-autojoin.el --- autojoin channels on connect and reconnects
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Alex Schroeder <alex@gnu.org>
|
||||
;; Keywords: irc
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcAutoJoin
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This allows us to customize an `erc-autojoin-channels-alist'. As
|
||||
;; we /JOIN and /PART channels, this alist is updated to reflect our
|
||||
;; current setup, so that when we reconnect, we rejoin the same
|
||||
;; channels. The alist can be customized, so that the customized
|
||||
;; value will be used when we reconnect in our next Emacs session.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
;;; Minor Mode
|
||||
|
||||
(defgroup erc-autojoin nil
|
||||
"Enable autojoining."
|
||||
:group 'erc)
|
||||
|
||||
;;;###autoload (autoload 'erc-autojoin-mode "erc-autojoin" nil t)
|
||||
(define-erc-module autojoin nil
|
||||
"Makes ERC autojoin on connects and reconnects."
|
||||
((add-hook 'erc-after-connect 'erc-autojoin-channels)
|
||||
(add-hook 'erc-server-JOIN-functions 'erc-autojoin-add)
|
||||
(add-hook 'erc-server-PART-functions 'erc-autojoin-remove))
|
||||
((remove-hook 'erc-after-connect 'erc-autojoin-channels)
|
||||
(remove-hook 'erc-server-JOIN-functions 'erc-autojoin-add)
|
||||
(remove-hook 'erc-server-PART-functions 'erc-autojoin-remove)))
|
||||
|
||||
(defcustom erc-autojoin-channels-alist nil
|
||||
"Alist of channels to autojoin on IRC networks.
|
||||
Every element in the alist has the form (SERVER . CHANNELS).
|
||||
SERVER is a regexp matching the server, and channels is the
|
||||
list of channels to join.
|
||||
|
||||
Customize this variable to set the value for your first connect.
|
||||
Once you are connected and join and part channels, this alist
|
||||
keeps track of what channels you are on, and will join them
|
||||
again when you get disconnected. When you restart Emacs, however,
|
||||
those changes are lost, and the customization you saved the last
|
||||
time is used again."
|
||||
:group 'erc-autojoin
|
||||
:type '(repeat (cons :tag "Server"
|
||||
(regexp :tag "Name")
|
||||
(repeat :tag "Channels"
|
||||
(string :tag "Name")))))
|
||||
|
||||
(defcustom erc-autojoin-domain-only t
|
||||
"Truncate host name to the domain name when joining a server.
|
||||
If non-nil, and a channel on the server a.b.c is joined, then
|
||||
only b.c is used as the server for `erc-autojoin-channels-alist'.
|
||||
This is important for networks that redirect you to other
|
||||
servers, presumably in the same domain."
|
||||
:group 'erc-autojoin
|
||||
:type 'boolean)
|
||||
|
||||
(defun erc-autojoin-channels (server nick)
|
||||
"Autojoin channels in `erc-autojoin-channels-alist'."
|
||||
(dolist (l erc-autojoin-channels-alist)
|
||||
(when (string-match (car l) server)
|
||||
(dolist (chan (cdr l))
|
||||
(erc-server-send (concat "join " chan))))))
|
||||
|
||||
(defun erc-autojoin-add (proc parsed)
|
||||
"Add the channel being joined to `erc-autojoin-channels-alist'."
|
||||
(let* ((chnl (erc-response.contents parsed))
|
||||
(nick (car (erc-parse-user (erc-response.sender parsed))))
|
||||
(server (with-current-buffer (process-buffer proc)
|
||||
(or erc-server-announced-name erc-session-server))))
|
||||
(when (erc-current-nick-p nick)
|
||||
(when (and erc-autojoin-domain-only
|
||||
(string-match "[^.]+\\.\\([^.]+\\.[^.]+\\)$" server))
|
||||
(setq server (match-string 1 server)))
|
||||
(let ((elem (assoc server erc-autojoin-channels-alist)))
|
||||
(if elem
|
||||
(unless (member chnl (cdr elem))
|
||||
(setcdr elem (cons chnl (cdr elem))))
|
||||
(setq erc-autojoin-channels-alist
|
||||
(cons (list server chnl)
|
||||
erc-autojoin-channels-alist))))))
|
||||
;; We must return nil to tell ERC to continue running the other
|
||||
;; functions.
|
||||
nil)
|
||||
|
||||
;; (erc-parse-user "kensanata!~user@dclient217-162-233-228.hispeed.ch")
|
||||
|
||||
(defun erc-autojoin-remove (proc parsed)
|
||||
"Remove the channel being left from `erc-autojoin-channels-alist'."
|
||||
(let* ((chnl (car (erc-response.command-args parsed)))
|
||||
(nick (car (erc-parse-user (erc-response.sender parsed))))
|
||||
(server (with-current-buffer (process-buffer proc)
|
||||
(or erc-server-announced-name erc-session-server))))
|
||||
(when (erc-current-nick-p nick)
|
||||
(when (and erc-autojoin-domain-only
|
||||
(string-match "[^.]+\\.\\([^.]+\\.[^.]+\\)$" server))
|
||||
(setq server (match-string 1 server)))
|
||||
(let ((elem (assoc server erc-autojoin-channels-alist)))
|
||||
(when elem
|
||||
(setcdr elem (delete chnl (cdr elem)))
|
||||
(unless (cdr elem)
|
||||
(setq erc-autojoin-channels-alist
|
||||
(delete elem erc-autojoin-channels-alist)))))))
|
||||
;; We must return nil to tell ERC to continue running the other
|
||||
;; functions.
|
||||
nil)
|
||||
|
||||
(provide 'erc-autojoin)
|
||||
|
||||
;;; erc-autojoin.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: d62d8b15-8e31-49d6-8a73-12f11e717414
|
||||
1786
lisp/erc/erc-backend.el
Normal file
1786
lisp/erc/erc-backend.el
Normal file
File diff suppressed because it is too large
Load diff
504
lisp/erc/erc-button.el
Normal file
504
lisp/erc/erc-button.el
Normal file
|
|
@ -0,0 +1,504 @@
|
|||
;; erc-button.el --- A way of buttonizing certain things in ERC buffers
|
||||
|
||||
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
||||
;; 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
;; Keywords: irc, button, url, regexp
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcButton
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Heavily borrowed from gnus-art.el. Thanks to the original authors.
|
||||
;; This buttonizes nicks and other stuff to make it all clickable.
|
||||
;; To enable, add to your ~/.emacs:
|
||||
;; (require 'erc-button)
|
||||
;; (erc-button-mode 1)
|
||||
;;
|
||||
;; Todo:
|
||||
;; * Rewrite all this to do the same, but use button.el from GNU Emacs
|
||||
;; if it's available for xemacs too. Why? button.el is much faster,
|
||||
;; and much more elegant, and solves the problem we get with large buffers
|
||||
;; and a large erc-button-marker-list.
|
||||
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'wid-edit)
|
||||
(require 'erc-fill)
|
||||
|
||||
;;; Minor Mode
|
||||
|
||||
(defgroup erc-button nil
|
||||
"Define how text can be turned into clickable buttons."
|
||||
:group 'erc)
|
||||
|
||||
;;;###autoload (autoload 'erc-button-mode "erc-button" nil t)
|
||||
(define-erc-module button nil
|
||||
"This mode buttonizes all messages according to `erc-button-alist'."
|
||||
((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append)
|
||||
(add-hook 'erc-send-modify-hook 'erc-button-add-buttons 'append)
|
||||
(add-hook 'erc-complete-functions 'erc-button-next))
|
||||
((remove-hook 'erc-insert-modify-hook 'erc-button-add-buttons)
|
||||
(remove-hook 'erc-send-modify-hook 'erc-button-add-buttons)
|
||||
(remove-hook 'erc-complete-functions 'erc-button-next)))
|
||||
|
||||
;; Make XEmacs use `erc-button-face'.
|
||||
(when (featurep 'xemacs)
|
||||
(add-hook 'erc-mode-hook
|
||||
(lambda () (set (make-local-variable 'widget-button-face) nil))))
|
||||
|
||||
;;; Variables
|
||||
|
||||
(defface erc-button '((t (:bold t)))
|
||||
"ERC button face."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defcustom erc-button-face 'erc-button
|
||||
"Face used for highlighting buttons in ERC buffers.
|
||||
|
||||
A button is a piece of text that you can activate by pressing
|
||||
`RET' or `mouse-2' above it. See also `erc-button-keymap'."
|
||||
:type 'face
|
||||
:group 'erc-faces)
|
||||
|
||||
(defcustom erc-button-nickname-face 'erc-nick-default-face
|
||||
"Face used for ERC nickname buttons."
|
||||
:type 'face
|
||||
:group 'erc-faces)
|
||||
|
||||
(defcustom erc-button-mouse-face 'highlight
|
||||
"Face used for mouse highlighting in ERC buffers.
|
||||
|
||||
Buttons will be displayed in this face when the mouse cursor is
|
||||
above them."
|
||||
:type 'face
|
||||
:group 'erc-faces)
|
||||
|
||||
(defcustom erc-button-url-regexp
|
||||
(concat "\\(www\\.\\|\\(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 'erc-button
|
||||
:type 'regexp)
|
||||
|
||||
(defcustom erc-button-wrap-long-urls nil
|
||||
"If non-nil, \"long\" URLs matching `erc-button-url-regexp' will be wrapped.
|
||||
|
||||
If this variable is a number, consider URLs longer than its value to
|
||||
be \"long\". If t, URLs will be considered \"long\" if they are
|
||||
longer than `erc-fill-column'."
|
||||
:group 'erc-button
|
||||
:type '(choice integer boolean))
|
||||
|
||||
(defcustom erc-button-buttonize-nicks t
|
||||
"Flag indicating whether nicks should be buttonized or not."
|
||||
:group 'erc-button
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-button-rfc-url "http://www.faqs.org/rfcs/rfc%s.html"
|
||||
"*URL used to browse rfc references.
|
||||
%s is replaced by the number."
|
||||
:group 'erc-button
|
||||
:type 'string)
|
||||
|
||||
(defcustom erc-button-google-url "http://www.google.com/search?q=%s"
|
||||
"*URL used to browse Google search references.
|
||||
%s is replaced by the search string."
|
||||
:group 'erc-button
|
||||
:type 'string)
|
||||
|
||||
(defcustom erc-button-alist
|
||||
;; Since the callback is only executed when the user is clicking on
|
||||
;; a button, it makes no sense to optimize performance by
|
||||
;; bytecompiling lambdas in this alist. On the other hand, it makes
|
||||
;; things hard to maintain.
|
||||
'(('nicknames 0 erc-button-buttonize-nicks erc-nick-popup 0)
|
||||
(erc-button-url-regexp 0 t browse-url 0)
|
||||
("<URL: *\\([^<> ]+\\) *>" 0 t browse-url 1)
|
||||
("(\\(\\([^~\n \t@][^\n \t@]*\\)@\\([a-zA-Z0-9.:-]+\\)\\)" 1 t finger 2 3)
|
||||
;; emacs internal
|
||||
("[`]\\([a-zA-Z][-a-zA-Z_0-9]+\\)[']" 1 t erc-button-describe-symbol 1)
|
||||
;; pseudo links
|
||||
("\\bInfo:[\"]\\([^\"]+\\)[\"]" 0 t Info-goto-node 1)
|
||||
("\\b\\(Ward\\|Wiki\\|WardsWiki\\|TheWiki\\):\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)"
|
||||
0 t (lambda (page)
|
||||
(browse-url (concat "http://c2.com/cgi-bin/wiki?" page)))
|
||||
2)
|
||||
("EmacsWiki:\\([A-Z][a-z]+\\([A-Z][a-z]+\\)+\\)" 0 t erc-browse-emacswiki 1)
|
||||
("Lisp:\\([a-zA-Z.+-]+\\)" 0 t erc-browse-emacswiki-lisp 1)
|
||||
("\\bGoogle:\\([^ \t\n\r\f]+\\)"
|
||||
0 t (lambda (keywords)
|
||||
(browse-url (format erc-button-google-url keywords)))
|
||||
1)
|
||||
("\\brfc[#: ]?\\([0-9]+\\)"
|
||||
0 t (lambda (num)
|
||||
(browse-url (format erc-button-rfc-url num)))
|
||||
1)
|
||||
;; other
|
||||
("\\s-\\(@\\([0-9][0-9][0-9]\\)\\)" 1 t erc-button-beats-to-time 2))
|
||||
"*Alist of regexps matching buttons in ERC buffers.
|
||||
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
|
||||
|
||||
REGEXP is the string matching text around the button or a symbol
|
||||
indicating a variable holding that string, or a list of
|
||||
strings, or an alist with the strings in the car. Note that
|
||||
entries in lists or alists are considered to be nicks or other
|
||||
complete words. Therefore they are enclosed in \\< and \\>
|
||||
while searching. REGEXP can also be the quoted symbol
|
||||
'nicknames, which matches the nickname of any user on the
|
||||
current server.
|
||||
|
||||
BUTTON is the number of the regexp grouping actually matching the
|
||||
button, This is ignored if REGEXP is 'nicknames.
|
||||
|
||||
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.
|
||||
CALLBACK can also be a symbol. Its variable value will be used
|
||||
as the callback function.
|
||||
|
||||
PAR is a number of a regexp grouping whose text will be passed to
|
||||
CALLBACK. There can be several PAR arguments. If REGEXP is
|
||||
'nicknames, these are ignored, and CALLBACK will be called with
|
||||
the nickname matched as the argument."
|
||||
:group 'erc-button
|
||||
:type '(repeat
|
||||
(list :tag "Button"
|
||||
(choice :tag "Matches"
|
||||
regexp
|
||||
(variable :tag "Variable containing regexp")
|
||||
(const :tag "Nicknames" 'nicknames))
|
||||
(integer :tag "Number of the regexp section that matches")
|
||||
(choice :tag "When to buttonize"
|
||||
(const :tag "Always" t)
|
||||
(sexp :tag "Only when this evaluates to non-nil"))
|
||||
(function :tag "Function to call when button is pressed")
|
||||
(repeat :tag "Sections of regexp to send to the function"
|
||||
:inline t
|
||||
(integer :tag "Regexp section number")))))
|
||||
|
||||
(defcustom erc-emacswiki-url "http://www.emacswiki.org/cgi-bin/wiki.pl?"
|
||||
"*URL of the EmacsWiki Homepage."
|
||||
:group 'erc-button
|
||||
:type 'string)
|
||||
|
||||
(defcustom erc-emacswiki-lisp-url "http://www.emacswiki.org/elisp/"
|
||||
"*URL of the EmacsWiki ELisp area."
|
||||
:group 'erc-button
|
||||
:type 'string)
|
||||
|
||||
(defvar erc-button-keymap
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "RET") 'erc-button-press-button)
|
||||
(if (featurep 'xemacs)
|
||||
(define-key map (kbd "<button2>") 'erc-button-click-button)
|
||||
(define-key map (kbd "<mouse-2>") 'erc-button-click-button))
|
||||
(define-key map (kbd "TAB") 'erc-button-next)
|
||||
(set-keymap-parent map erc-mode-map)
|
||||
map)
|
||||
"Local keymap for ERC buttons.")
|
||||
|
||||
(defvar erc-button-syntax-table
|
||||
(let ((table (make-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)
|
||||
(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)
|
||||
(modify-syntax-entry ?\\ "w" table)
|
||||
table)
|
||||
"Syntax table used when buttonizing messages.
|
||||
This syntax table should make all the legal nick characters word
|
||||
constituents.")
|
||||
|
||||
(defun erc-button-add-buttons ()
|
||||
"Find external references in the current buffer and make buttons of them.
|
||||
\"External references\" are things like URLs, as
|
||||
specified by `erc-button-alist'."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(with-syntax-table erc-button-syntax-table
|
||||
(let ((buffer-read-only nil)
|
||||
(inhibit-point-motion-hooks t)
|
||||
(inhibit-field-text-motion t)
|
||||
(alist erc-button-alist)
|
||||
entry regexp data)
|
||||
(erc-button-remove-old-buttons)
|
||||
(dolist (entry alist)
|
||||
(if (equal (car entry) (quote (quote nicknames)))
|
||||
(erc-button-add-nickname-buttons entry)
|
||||
(progn
|
||||
(setq regexp (or (and (stringp (car entry)) (car entry))
|
||||
(and (boundp (car entry))
|
||||
(symbol-value (car entry)))))
|
||||
(cond ((stringp regexp)
|
||||
(erc-button-add-buttons-1 regexp entry))
|
||||
((and (listp regexp) (stringp (car regexp)))
|
||||
(dolist (r regexp)
|
||||
(erc-button-add-buttons-1
|
||||
(concat "\\<" (regexp-quote r) "\\>")
|
||||
entry)))
|
||||
((and (listp regexp) (listp (car regexp))
|
||||
(stringp (caar regexp)))
|
||||
(dolist (elem regexp)
|
||||
(erc-button-add-buttons-1
|
||||
(concat "\\<" (regexp-quote (car elem)) "\\>")
|
||||
entry)))))))))))
|
||||
|
||||
(defun erc-button-add-nickname-buttons (entry)
|
||||
"Search through the buffer for nicknames, and add buttons."
|
||||
(let ((form (nth 2 entry))
|
||||
(fun (nth 3 entry))
|
||||
bounds word)
|
||||
(when (or (eq t form)
|
||||
(eval form))
|
||||
(goto-char (point-min))
|
||||
(while (forward-word 1)
|
||||
(setq bounds (bounds-of-thing-at-point 'word))
|
||||
(setq word (buffer-substring-no-properties
|
||||
(car bounds) (cdr bounds)))
|
||||
(if (erc-get-server-user word)
|
||||
(erc-button-add-button (car bounds) (cdr bounds)
|
||||
fun t (list word)))))))
|
||||
|
||||
(defun erc-button-add-buttons-1 (regexp entry)
|
||||
"Search through the buffer for matches to ENTRY and add buttons."
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(let ((start (match-beginning (nth 1 entry)))
|
||||
(end (match-end (nth 1 entry)))
|
||||
(form (nth 2 entry))
|
||||
(fun (nth 3 entry))
|
||||
(data (mapcar 'match-string (nthcdr 4 entry))))
|
||||
(when (or (eq t form)
|
||||
(eval form))
|
||||
(erc-button-add-button start end fun nil data regexp)))))
|
||||
|
||||
(defun erc-button-remove-old-buttons ()
|
||||
"Remove all existing buttons.
|
||||
This is called with narrowing in effect, just before the text is
|
||||
buttonized again. Removing a button means to remove all the properties
|
||||
that `erc-button-add-button' adds, except for the face."
|
||||
(remove-text-properties
|
||||
(point-min) (point-max)
|
||||
'(erc-callback nil
|
||||
erc-data nil
|
||||
mouse-face nil
|
||||
keymap nil)))
|
||||
|
||||
(defun erc-button-add-button (from to fun nick-p &optional data regexp)
|
||||
"Create a button between FROM and TO with callback FUN and data DATA.
|
||||
NICK-P specifies if this is a nickname button.
|
||||
REGEXP is the regular expression which matched for this button."
|
||||
;; Really nasty hack to <URL: > ise urls, and line-wrap them if
|
||||
;; they're going to be wider than `erc-fill-column'.
|
||||
;; This could be a lot cleaner, but it works for me -- lawrence.
|
||||
(let (fill-column)
|
||||
(when (and erc-button-wrap-long-urls
|
||||
(string= regexp erc-button-url-regexp)
|
||||
(> (- to from)
|
||||
(setq fill-column (- (if (numberp erc-button-wrap-long-urls)
|
||||
erc-button-wrap-long-urls
|
||||
erc-fill-column)
|
||||
(length erc-fill-prefix)))))
|
||||
(setq to (prog1 (point-marker) (insert ">"))
|
||||
from (prog2 (goto-char from) (point-marker) (insert "<URL: ")))
|
||||
(let ((pos (copy-marker from)))
|
||||
(while (> (- to pos) fill-column)
|
||||
(goto-char (+ pos fill-column))
|
||||
(insert "\n" erc-fill-prefix) ; This ought to figure out
|
||||
; what type of filling we're
|
||||
; doing, and indent accordingly.
|
||||
(move-marker pos (point))))))
|
||||
(if nick-p
|
||||
(when erc-button-nickname-face
|
||||
(erc-button-add-face from to erc-button-nickname-face))
|
||||
(when erc-button-face
|
||||
(erc-button-add-face from to erc-button-face)))
|
||||
(add-text-properties
|
||||
from to
|
||||
(nconc (and erc-button-mouse-face
|
||||
(list 'mouse-face erc-button-mouse-face))
|
||||
(list 'erc-callback fun)
|
||||
(list 'keymap erc-button-keymap)
|
||||
(list 'rear-nonsticky t)
|
||||
(and data (list 'erc-data data))))
|
||||
(widget-convert-button 'link from to :action 'erc-button-press-button
|
||||
:suppress-face t
|
||||
;; Make XEmacs use our faces.
|
||||
:button-face (if nick-p
|
||||
erc-button-nickname-face
|
||||
erc-button-face)
|
||||
;; Make XEmacs behave with mouse-clicks, for
|
||||
;; some reason, widget stuff overrides the
|
||||
;; 'keymap text-property.
|
||||
:mouse-down-action 'erc-button-click-button))
|
||||
|
||||
(defun erc-button-add-face (from to face)
|
||||
"Add FACE to the region between FROM and TO."
|
||||
;; If we just use `add-text-property', then this will overwrite any
|
||||
;; face text property already used for the button. It will not be
|
||||
;; merged correctly. If we use overlays, then redisplay will be
|
||||
;; very slow with lots of buttons. This is why we manually merge
|
||||
;; face text properties.
|
||||
(let ((old (erc-list (get-text-property from 'face)))
|
||||
(pos from)
|
||||
(end (next-single-property-change from 'face nil to))
|
||||
new)
|
||||
;; old is the face at pos, in list form. It is nil if there is no
|
||||
;; face at pos. If nil, the new face is FACE. If not nil, the
|
||||
;; new face is a list containing FACE and the old stuff. end is
|
||||
;; where this face changes.
|
||||
(while (< pos to)
|
||||
(setq new (if old (cons face old) face))
|
||||
(put-text-property pos end 'face new)
|
||||
(setq pos end
|
||||
old (erc-list (get-text-property pos 'face))
|
||||
end (next-single-property-change pos 'face nil to)))))
|
||||
|
||||
;; widget-button-click calls with two args, we ignore the first.
|
||||
;; Since Emacs runs this directly, rather than with
|
||||
;; widget-button-click, we need to fake an extra arg in the
|
||||
;; interactive spec.
|
||||
(defun erc-button-click-button (ignore event)
|
||||
"Call `erc-button-press-button'."
|
||||
(interactive "P\ne")
|
||||
(save-excursion
|
||||
(mouse-set-point event)
|
||||
(erc-button-press-button)))
|
||||
|
||||
;; XEmacs calls this via widget-button-press with a bunch of arguments
|
||||
;; which we don't care about.
|
||||
(defun erc-button-press-button (&rest ignore)
|
||||
"Check text at point for a callback function.
|
||||
If the text at point has a `erc-callback' property,
|
||||
call it with the value of the `erc-data' text property."
|
||||
(interactive)
|
||||
(let* ((data (get-text-property (point) 'erc-data))
|
||||
(fun (get-text-property (point) 'erc-callback)))
|
||||
(unless fun
|
||||
(message "No button at point"))
|
||||
(when (and fun (symbolp fun) (not (fboundp fun)))
|
||||
(error "Function %S is not bound" fun))
|
||||
(apply fun data)))
|
||||
|
||||
(defun erc-button-next ()
|
||||
"Go to the next button in this buffer."
|
||||
(interactive)
|
||||
(let ((here (point)))
|
||||
(when (< here (erc-beg-of-input-line))
|
||||
(while (and (get-text-property here 'erc-callback)
|
||||
(not (= here (point-max))))
|
||||
(setq here (1+ here)))
|
||||
(while (and (not (get-text-property here 'erc-callback))
|
||||
(not (= here (point-max))))
|
||||
(setq here (1+ here)))
|
||||
(if (< here (point-max))
|
||||
(goto-char here)
|
||||
(error "No next button"))
|
||||
t)))
|
||||
|
||||
(defun erc-browse-emacswiki (thing)
|
||||
"Browse to thing in the emacs-wiki."
|
||||
(browse-url (concat erc-emacswiki-url thing)))
|
||||
|
||||
(defun erc-browse-emacswiki-lisp (thing)
|
||||
"Browse to THING in the emacs-wiki elisp area."
|
||||
(browse-url (concat erc-emacswiki-lisp-url thing)))
|
||||
|
||||
;;; Nickname buttons:
|
||||
|
||||
(defcustom erc-nick-popup-alist
|
||||
'(("DeOp" . (erc-cmd-DEOP nick))
|
||||
("Kick" . (erc-cmd-KICK (concat nick " "
|
||||
(read-from-minibuffer
|
||||
(concat "Kick " nick ", reason: ")))))
|
||||
("Msg" . (erc-cmd-MSG (concat nick " "
|
||||
(read-from-minibuffer
|
||||
(concat "Message to " nick ": ")))))
|
||||
("Op" . (erc-cmd-OP nick))
|
||||
("Query" . (erc-cmd-QUERY nick))
|
||||
("Whois" . (erc-cmd-WHOIS nick))
|
||||
("Lastlog" . (erc-cmd-LASTLOG nick)))
|
||||
"*An alist of possible actions to take on a nickname.
|
||||
An entry looks like (\"Action\" . SEXP) where SEXP is evaluated with
|
||||
the variable `nick' bound to the nick in question.
|
||||
|
||||
Examples:
|
||||
(\"DebianDB\" .
|
||||
(shell-command
|
||||
(format
|
||||
\"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\"
|
||||
nick)))"
|
||||
:group 'erc-button
|
||||
:type '(repeat (cons (string :tag "Op")
|
||||
sexp)))
|
||||
|
||||
(defun erc-nick-popup (nick)
|
||||
(let* ((completion-ignore-case t)
|
||||
(action (completing-read (concat "What action to take on '" nick "'? ")
|
||||
erc-nick-popup-alist))
|
||||
(code (cdr (assoc action erc-nick-popup-alist))))
|
||||
(when code
|
||||
(erc-set-active-buffer (current-buffer))
|
||||
(eval code))))
|
||||
|
||||
;;; Callback functions
|
||||
(defun erc-button-describe-symbol (symbol-name)
|
||||
"Describe SYMBOL-NAME.
|
||||
Use `describe-function' for functions, `describe-variable' for variables,
|
||||
and `apropos' for other symbols."
|
||||
(let ((symbol (intern-soft symbol-name)))
|
||||
(cond ((and symbol (fboundp symbol))
|
||||
(describe-function symbol))
|
||||
((and symbol (boundp symbol))
|
||||
(describe-variable symbol))
|
||||
(t (apropos symbol-name)))))
|
||||
|
||||
(defun erc-button-beats-to-time (beats)
|
||||
"Display BEATS in a readable time format."
|
||||
(let* ((seconds (- (* (string-to-number beats) 86.4)
|
||||
3600
|
||||
(- (car (current-time-zone)))))
|
||||
(hours (mod (floor seconds 3600) 24))
|
||||
(minutes (mod (round seconds 60) 60)))
|
||||
(message (format "@%s is %d:%02d local time"
|
||||
beats hours minutes))))
|
||||
|
||||
(provide 'erc-button)
|
||||
|
||||
;;; erc-button.el ends here
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 7d23bed4-2f30-4273-a03f-d7a274c605c4
|
||||
207
lisp/erc/erc-compat.el
Normal file
207
lisp/erc/erc-compat.el
Normal file
|
|
@ -0,0 +1,207 @@
|
|||
;;; erc-compat.el --- ERC compatibility code for XEmacs
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Alex Schroeder <alex@gnu.org>
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?EmacsIRCClient
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This mostly defines stuff that cannot be worked around easily.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'format-spec)
|
||||
|
||||
;;;###autoload (autoload 'erc-define-minor-mode "erc-compat")
|
||||
(defalias 'erc-define-minor-mode 'define-minor-mode)
|
||||
(put 'erc-define-minor-mode 'edebug-form-spec 'define-minor-mode)
|
||||
|
||||
(defun erc-decode-coding-string (s coding-system)
|
||||
"Decode S using CODING-SYSTEM."
|
||||
(decode-coding-string s coding-system t))
|
||||
|
||||
(defun erc-encode-coding-string (s coding-system)
|
||||
"Encode S using CODING-SYSTEM.
|
||||
Return the same string, if the encoding operation is trivial.
|
||||
See `erc-encoding-coding-alist'."
|
||||
(encode-coding-string s coding-system t))
|
||||
|
||||
(defalias 'erc-propertize 'propertize)
|
||||
(defalias 'erc-view-mode-enter 'view-mode-enter)
|
||||
(defalias 'erc-function-arglist 'help-function-arglist)
|
||||
(defalias 'erc-delete-dups 'delete-dups)
|
||||
(defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string)
|
||||
|
||||
(defvar erc-emacs-build-time
|
||||
(if (stringp emacs-build-time)
|
||||
emacs-build-time
|
||||
(format-time-string "%Y-%m-%d" emacs-build-time))
|
||||
"Time at which Emacs was dumped out.")
|
||||
|
||||
;; XEmacs' `replace-match' does not replace matching subexpressions in strings.
|
||||
(defun erc-replace-match-subexpression-in-string
|
||||
(newtext string match subexp start &optional fixedcase literal)
|
||||
"Replace the subexpression SUBEXP of the last match in STRING with NEWTEXT.
|
||||
MATCH is the text which matched the subexpression (see `match-string').
|
||||
START is the beginning position of the last match (see `match-beginning').
|
||||
See `replace-match' for explanations of FIXEDCASE and LITERAL."
|
||||
(cond ((featurep 'xemacs)
|
||||
(string-match match string start)
|
||||
(replace-match newtext fixedcase literal string))
|
||||
(t (replace-match newtext fixedcase literal string subexp))))
|
||||
|
||||
(defalias 'erc-cancel-timer 'cancel-timer)
|
||||
(defalias 'erc-make-obsolete 'make-obsolete)
|
||||
(defalias 'erc-make-obsolete-variable 'make-obsolete-variable)
|
||||
|
||||
;; Provde an equivalent of `assert', based on the code from cl-macs.el
|
||||
(defun erc-const-expr-p (x)
|
||||
(cond ((consp x)
|
||||
(or (eq (car x) 'quote)
|
||||
(and (memq (car x) '(function function*))
|
||||
(or (symbolp (nth 1 x))
|
||||
(and (eq (and (consp (nth 1 x))
|
||||
(car (nth 1 x))) 'lambda) 'func)))))
|
||||
((symbolp x) (and (memq x '(nil t)) t))
|
||||
(t t)))
|
||||
|
||||
(put 'erc-assertion-failed 'error-conditions '(error))
|
||||
(put 'erc-assertion-failed 'error-message "Assertion failed")
|
||||
|
||||
(defun erc-list* (arg &rest rest)
|
||||
"Return a new list with specified args as elements, cons'd to last arg.
|
||||
Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
|
||||
`(cons A (cons B (cons C D)))'."
|
||||
(cond ((not rest) arg)
|
||||
((not (cdr rest)) (cons arg (car rest)))
|
||||
(t (let* ((n (length rest))
|
||||
(copy (copy-sequence rest))
|
||||
(last (nthcdr (- n 2) copy)))
|
||||
(setcdr last (car (cdr last)))
|
||||
(cons arg copy)))))
|
||||
|
||||
(defmacro erc-assert (form &optional show-args string &rest args)
|
||||
"Verify that FORM returns non-nil; signal an error if not.
|
||||
Second arg SHOW-ARGS means to include arguments of FORM in message.
|
||||
Other args STRING and ARGS... are arguments to be passed to `error'.
|
||||
They are not evaluated unless the assertion fails. If STRING is
|
||||
omitted, a default message listing FORM itself is used."
|
||||
(let ((sargs
|
||||
(and show-args
|
||||
(delq nil (mapcar
|
||||
(function
|
||||
(lambda (x)
|
||||
(and (not (erc-const-expr-p x)) x)))
|
||||
(cdr form))))))
|
||||
(list 'progn
|
||||
(list 'or form
|
||||
(if string
|
||||
(erc-list* 'error string (append sargs args))
|
||||
(list 'signal '(quote erc-assertion-failed)
|
||||
(erc-list* 'list (list 'quote form) sargs))))
|
||||
nil)))
|
||||
|
||||
;; Provide a simpler replacement for `member-if'
|
||||
(defun erc-member-if (predicate list)
|
||||
"Find the first item satisfying PREDICATE in LIST.
|
||||
Return the sublist of LIST whose car matches."
|
||||
(let ((ptr list))
|
||||
(catch 'found
|
||||
(while ptr
|
||||
(when (funcall predicate (car ptr))
|
||||
(throw 'found ptr))
|
||||
(setq ptr (cdr ptr))))))
|
||||
|
||||
;; Provide a simpler replacement for `delete-if'
|
||||
(defun erc-delete-if (predicate seq)
|
||||
"Remove all items satisfying PREDICATE in SEQ.
|
||||
This is a destructive function: it reuses the storage of SEQ
|
||||
whenever possible."
|
||||
;; remove from car
|
||||
(while (when (funcall predicate (car seq))
|
||||
(setq seq (cdr seq))))
|
||||
;; remove from cdr
|
||||
(let ((ptr seq)
|
||||
(next (cdr seq)))
|
||||
(while next
|
||||
(when (funcall predicate (car next))
|
||||
(setcdr ptr (if (consp next)
|
||||
(cdr next)
|
||||
nil)))
|
||||
(setq ptr (cdr ptr))
|
||||
(setq next (cdr ptr))))
|
||||
seq)
|
||||
|
||||
;; Provide a simpler replacement for `remove-if-not'
|
||||
(defun erc-remove-if-not (predicate seq)
|
||||
"Remove all items not satisfying PREDICATE in SEQ.
|
||||
This is a non-destructive function; it makes a copy of SEQ to
|
||||
avoid corrupting the original SEQ."
|
||||
(let (newseq)
|
||||
(dolist (el seq)
|
||||
(when (funcall predicate el)
|
||||
(setq newseq (cons el newseq))))
|
||||
(nreverse newseq)))
|
||||
|
||||
;; Provide a simpler replacement for `gensym'.
|
||||
(defvar *erc-sym-counter* 0)
|
||||
(defun erc-gensym ()
|
||||
"Generate a new uninterned symbol."
|
||||
(let ((num (prog1 *erc-sym-counter*
|
||||
(setq *erc-sym-counter* (1+ *erc-sym-counter*)))))
|
||||
(make-symbol (format "*erc-sym-%d*" num))))
|
||||
|
||||
;; Copied from cl-extra.el
|
||||
(defun erc-subseq (seq start &optional end)
|
||||
"Return the subsequence of SEQ from START to END.
|
||||
If END is omitted, it defaults to the length of the sequence.
|
||||
If START or END is negative, it counts from the end."
|
||||
(if (stringp seq) (substring seq start end)
|
||||
(let (len)
|
||||
(and end (< end 0) (setq end (+ end (setq len (length seq)))))
|
||||
(if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
|
||||
(cond ((listp seq)
|
||||
(if (> start 0) (setq seq (nthcdr start seq)))
|
||||
(if end
|
||||
(let ((res nil))
|
||||
(while (>= (setq end (1- end)) start)
|
||||
(push (pop seq) res))
|
||||
(nreverse res))
|
||||
(copy-sequence seq)))
|
||||
(t
|
||||
(or end (setq end (or len (length seq))))
|
||||
(let ((res (make-vector (max (- end start) 0) nil))
|
||||
(i 0))
|
||||
(while (< start end)
|
||||
(aset res i (aref seq start))
|
||||
(setq i (1+ i) start (1+ start)))
|
||||
res))))))
|
||||
|
||||
(provide 'erc-compat)
|
||||
|
||||
;;; erc-compat.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 8948ffe0-aff8-4ad8-a196-368ebbfd58ff
|
||||
222
lisp/erc/erc-complete.el
Normal file
222
lisp/erc/erc-complete.el
Normal file
|
|
@ -0,0 +1,222 @@
|
|||
;;; erc-complete.el --- Provides Nick name completion for ERC
|
||||
|
||||
;; Copyright (C) 2001, 2002, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Alex Schroeder <alex@gnu.org>
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file is obsolete. Use completion from erc-pcomplete instead.
|
||||
;; This file is based on hippie-expand, while the new file is based on
|
||||
;; pcomplete. There is no autoload cookie in this file. If you want
|
||||
;; to use the code in this file, add the following to your ~/.emacs:
|
||||
|
||||
;; (autoload 'erc-complete "erc-complete" "Complete nick at point." t)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'erc-match); for erc-pals
|
||||
(require 'hippie-exp); for the hippie expand stuff
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-complete ()
|
||||
"Complete nick at point.
|
||||
See `erc-try-complete-nick' for more technical info.
|
||||
This function is obsolete, use `erc-pcomplete' instead."
|
||||
(interactive)
|
||||
(let ((hippie-expand-try-functions-list '(erc-try-complete-nick)))
|
||||
(hippie-expand nil)))
|
||||
|
||||
(defgroup erc-old-complete nil
|
||||
"Nick completion. Obsolete, use erc-pcomplete instead."
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-nick-completion 'all
|
||||
"Determine how the list of nicks is determined during nick completion.
|
||||
See `erc-complete-nick' for information on how to activate this.
|
||||
|
||||
pals: Use `erc-pals'.
|
||||
all: All channel members.
|
||||
|
||||
You may also provide your own function that returns a list of completions.
|
||||
One example is `erc-nick-completion-exclude-myself',
|
||||
or you may use an arbitrary lisp expression."
|
||||
:type '(choice (const :tag "List of pals" pals)
|
||||
(const :tag "All channel members" all)
|
||||
(const :tag "All channel members except yourself"
|
||||
erc-nick-completion-exclude-myself)
|
||||
(repeat :tag "List" (string :tag "Nick"))
|
||||
function
|
||||
sexp)
|
||||
:group 'erc-old-complete)
|
||||
|
||||
(defcustom erc-nick-completion-ignore-case t
|
||||
"*Non-nil means don't consider case significant in nick completion.
|
||||
Case will be automatically corrected when non-nil.
|
||||
For instance if you type \"dely TAB\" the word completes and changes to
|
||||
\"delYsid\"."
|
||||
:group 'erc-old-complete
|
||||
:type 'boolean)
|
||||
|
||||
(defun erc-nick-completion-exclude-myself ()
|
||||
"Get a list of all the channel members except you.
|
||||
|
||||
This function returns a list of all the members in the channel, except
|
||||
your own nick. This way if you're named foo and someone is called foobar,
|
||||
typing \"f o TAB\" will directly give you foobar. Use this with
|
||||
`erc-nick-completion'."
|
||||
(delete
|
||||
(erc-current-nick)
|
||||
(mapcar (function car) (erc-get-channel-user-list))))
|
||||
|
||||
(defcustom erc-nick-completion-postfix ": "
|
||||
"*When `erc-complete' is used in the first word after the prompt,
|
||||
add this string when a unique expansion was found."
|
||||
:group 'erc-old-complete
|
||||
:type 'string)
|
||||
|
||||
(defun erc-command-list ()
|
||||
"Returns a list of strings of the defined user commands."
|
||||
(let ((case-fold-search nil))
|
||||
(mapcar (lambda (x)
|
||||
(concat "/" (downcase (substring (symbol-name x) 8))))
|
||||
(apropos-internal "erc-cmd-[A-Z]+"))))
|
||||
|
||||
(defun erc-try-complete-nick (old)
|
||||
"Complete nick at point.
|
||||
This is a function to put on `hippie-expand-try-functions-list'.
|
||||
Then use \\[hippie-expand] to expand nicks.
|
||||
The type of completion depends on `erc-nick-completion'."
|
||||
(cond ((eq erc-nick-completion 'pals)
|
||||
(try-complete-erc-nick old erc-pals))
|
||||
((eq erc-nick-completion 'all)
|
||||
(try-complete-erc-nick old (append
|
||||
(mapcar (function car)
|
||||
(erc-get-channel-user-list))
|
||||
(erc-command-list))))
|
||||
((functionp erc-nick-completion)
|
||||
(try-complete-erc-nick old (funcall erc-nick-completion)))
|
||||
(t
|
||||
(try-complete-erc-nick old erc-nick-completion))))
|
||||
|
||||
(defvar try-complete-erc-nick-window-configuration nil
|
||||
"The window configuration for `try-complete-erc-nick'.
|
||||
When called the first time, a window config is stored here,
|
||||
and when completion is done, the window config is restored
|
||||
from here. See `try-complete-erc-nick-restore' and
|
||||
`try-complete-erc-nick'.")
|
||||
|
||||
(defun try-complete-erc-nick-restore ()
|
||||
"Restore window configuration."
|
||||
(if (not try-complete-erc-nick-window-configuration)
|
||||
(when (get-buffer "*Completions*")
|
||||
(delete-windows-on "*Completions*"))
|
||||
(set-window-configuration
|
||||
try-complete-erc-nick-window-configuration)
|
||||
(setq try-complete-erc-nick-window-configuration nil)))
|
||||
|
||||
(defun try-complete-erc-nick (old completions)
|
||||
"Try to complete current word depending on `erc-try-complete-nick'.
|
||||
The argument OLD has to be nil the first call of this function, and t
|
||||
for subsequent calls (for further possible completions of the same
|
||||
string). It returns t if a new completion is found, nil otherwise. The
|
||||
second argument COMPLETIONS is a list of completions to use. Actually,
|
||||
it is only used when OLD is nil. It will be copied to `he-expand-list'
|
||||
on the first call. After that, it is no longer used.
|
||||
Window configurations are stored in
|
||||
`try-complete-erc-nick-window-configuration'."
|
||||
(let (expansion
|
||||
final
|
||||
(alist (if (consp (car completions))
|
||||
completions
|
||||
(mapcar (lambda (s)
|
||||
(if (and (erc-complete-at-prompt)
|
||||
(and (not (= (length s) 0))
|
||||
(not (eq (elt s 0) ?/))))
|
||||
(list (concat s erc-nick-completion-postfix))
|
||||
(list (concat s " "))))
|
||||
completions))) ; make alist if required
|
||||
(completion-ignore-case erc-nick-completion-ignore-case))
|
||||
(he-init-string (he-dabbrev-beg) (point))
|
||||
;; If there is a string to complete, complete it using alist.
|
||||
;; expansion is the possible expansion, or t. If expansion is t
|
||||
;; or if expansion is the "real" thing, we are finished (final is
|
||||
;; t). Take care -- expansion can also be nil!
|
||||
(unless (string= he-search-string "")
|
||||
(setq expansion (try-completion he-search-string alist)
|
||||
final (or (eq t expansion)
|
||||
(and expansion
|
||||
(eq t (try-completion expansion alist))))))
|
||||
(cond ((not expansion)
|
||||
;; There is no expansion at all.
|
||||
(try-complete-erc-nick-restore)
|
||||
(he-reset-string)
|
||||
nil)
|
||||
((eq t expansion)
|
||||
;; The user already has the correct expansion.
|
||||
(try-complete-erc-nick-restore)
|
||||
(he-reset-string)
|
||||
t)
|
||||
((and old (string= expansion he-search-string))
|
||||
;; This is the second time around and nothing changed,
|
||||
;; ie. the user tried to expand something incomplete
|
||||
;; without making a choice -- hitting TAB twice, for
|
||||
;; example.
|
||||
(try-complete-erc-nick-restore)
|
||||
(he-reset-string)
|
||||
nil)
|
||||
(final
|
||||
;; The user has found the correct expansion.
|
||||
(try-complete-erc-nick-restore)
|
||||
(he-substitute-string expansion)
|
||||
t)
|
||||
(t
|
||||
;; We found something but we are not finished. Show a
|
||||
;; completions buffer. Substitute what we found and return
|
||||
;; t.
|
||||
(setq try-complete-erc-nick-window-configuration
|
||||
(current-window-configuration))
|
||||
(with-output-to-temp-buffer "*Completions*"
|
||||
(display-completion-list (all-completions he-search-string alist)))
|
||||
(he-substitute-string expansion)
|
||||
t))))
|
||||
|
||||
(defun erc-at-beginning-of-line-p (point &optional bol-func)
|
||||
(save-excursion
|
||||
(funcall (or bol-func
|
||||
'erc-bol))
|
||||
(equal point (point))))
|
||||
|
||||
(defun erc-complete-at-prompt ()
|
||||
"Returns t if point is directly after `erc-prompt' when doing completion."
|
||||
(erc-at-beginning-of-line-p (he-dabbrev-beg)))
|
||||
|
||||
(provide 'erc-complete)
|
||||
|
||||
;;; erc-complete.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 3be13ee8-8fdb-41ab-83c2-6582c757b91e
|
||||
1135
lisp/erc/erc-dcc.el
Normal file
1135
lisp/erc/erc-dcc.el
Normal file
File diff suppressed because it is too large
Load diff
180
lisp/erc/erc-ezbounce.el
Normal file
180
lisp/erc/erc-ezbounce.el
Normal file
|
|
@ -0,0 +1,180 @@
|
|||
;;; erc-ezbounce.el --- Handle EZBounce bouncer commands
|
||||
|
||||
;; Copyright (C) 2002, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Andreas Fuchs <asf@void.at>
|
||||
;; Keywords: comm
|
||||
|
||||
;; 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:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup erc-ezbounce nil
|
||||
"Interface to the EZBounce IRC bouncer (a virtual IRC server)"
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-ezb-regexp "^ezbounce!srv$"
|
||||
"Regexp used by the EZBouncer to identify itself to the user."
|
||||
:group 'erc-ezbounce
|
||||
:type 'string)
|
||||
|
||||
(defcustom erc-ezb-login-alist '()
|
||||
"Alist of logins suitable for the server we're connecting to.
|
||||
|
||||
The alist's format is as follows:
|
||||
|
||||
(((server . port) . (username . password))
|
||||
((server . port) . (username . password))
|
||||
...)"
|
||||
:group 'erc-ezbounce
|
||||
:type '(repeat
|
||||
(cons (cons :tag "Server"
|
||||
string
|
||||
string)
|
||||
(cons :tag "Login"
|
||||
string
|
||||
string))))
|
||||
|
||||
(defvar erc-ezb-action-alist '(("^\\[awaiting login/pass command\\]$" . erc-ezb-identify)
|
||||
("^\\[use /quote CONN <server> to connect\\]$" . erc-ezb-select)
|
||||
("^ID +IRC NICK +TO +TIME$" . erc-ezb-init-session-list)
|
||||
("^$" . erc-ezb-end-of-session-list)
|
||||
(".*" . erc-ezb-add-session))
|
||||
"Alist of actions to take on NOTICEs from EZBounce.")
|
||||
|
||||
|
||||
(defvar erc-ezb-session-list '()
|
||||
"List of detached EZBounce sessions.")
|
||||
(make-variable-buffer-local 'erc-ezb-session-list)
|
||||
|
||||
(defvar erc-ezb-inside-session-listing nil
|
||||
"Indicate whether current notices are expected to be EZB session listings.")
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-cmd-ezb (line &optional force)
|
||||
"Send EZB commands to the EZBouncer verbatim."
|
||||
(erc-server-send (concat "EZB " line)))
|
||||
(put 'erc-cmd-EZB 'do-not-parse-args t)
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-get-login (server port)
|
||||
"Return an appropriate EZBounce login for SERVER and PORT.
|
||||
Look up entries in `erc-ezb-login-alist'. If the username or password
|
||||
in the alist is `nil', prompt for the appropriate values."
|
||||
(let ((login (cdr (assoc (cons server port) erc-ezb-login-alist))))
|
||||
(when login
|
||||
(let ((username (car login))
|
||||
(password (cdr login)))
|
||||
(when (null username)
|
||||
(setq username (read-from-minibuffer (format "EZBounce user name for %s:%s: " server port))))
|
||||
(when (null password)
|
||||
(setq password (read-passwd (format "EZBounce password for %s:%s: " server port))))
|
||||
(cons username password)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-lookup-action (message)
|
||||
(let ((function-alist erc-ezb-action-alist)
|
||||
found)
|
||||
(while (and (not found)
|
||||
function-alist)
|
||||
(let ((regexp (caar function-alist))
|
||||
(function (cdar function-alist)))
|
||||
(when (string-match regexp message)
|
||||
(setq found function))
|
||||
(setq function-alist (cdr function-alist))))
|
||||
found))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-notice-autodetect (proc parsed)
|
||||
"React on an EZBounce NOTICE request."
|
||||
(let* ((sender (erc-response.sender parsed))
|
||||
(message (erc-response.contents parsed))
|
||||
(function (erc-ezb-lookup-action message)))
|
||||
(when (and (string-match erc-ezb-regexp sender)
|
||||
function)
|
||||
(funcall function message)))
|
||||
nil)
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-identify (message)
|
||||
"Identify to the EZBouncer server."
|
||||
(let ((login (erc-ezb-get-login erc-session-server (erc-port-to-string erc-session-port))))
|
||||
(unless (null login)
|
||||
(let ((username (car login))
|
||||
(pass (cdr login)))
|
||||
(erc-server-send (concat "LOGIN " username " " pass))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-init-session-list (message)
|
||||
"Reset the EZBounce session list to NIL."
|
||||
(setq erc-ezb-session-list nil)
|
||||
(setq erc-ezb-inside-session-listing t))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-end-of-session-list (message)
|
||||
"Indicate the end of the EZBounce session listing."
|
||||
(setq erc-ezb-inside-session-listing nil))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-add-session (message)
|
||||
"Add an EZBounce session to the session list."
|
||||
(when (and erc-ezb-inside-session-listing
|
||||
(string-match "^\\([^ ]+\\) +\\([^ ]+\\) +\\([^ ]+\\) +\\([^ ]+\\)$" message))
|
||||
(let ((id (match-string 1 message))
|
||||
(nick (match-string 2 message))
|
||||
(to (match-string 3 message)))
|
||||
(add-to-list 'erc-ezb-session-list (list id nick to)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-select (message)
|
||||
"Select an IRC server to use by EZBounce, in ERC style."
|
||||
(unless (and erc-ezb-session-list
|
||||
(erc-ezb-select-session))
|
||||
(let* ((server (read-from-minibuffer
|
||||
"IRC server: " "" nil nil 'erc-server-history-list))
|
||||
(port
|
||||
(erc-string-to-port
|
||||
(read-from-minibuffer "IRC port: "
|
||||
(erc-port-to-string "6667")))))
|
||||
(erc-server-send (format "CONN %s %s" server port)))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-select-session ()
|
||||
"Select a detached EZBounce session."
|
||||
(let ((session (completing-read "Existing Session (RET to enter a new one): "
|
||||
erc-ezb-session-list)))
|
||||
(if (string= session "")
|
||||
nil
|
||||
(erc-server-send (format "REATTACH %s" session)))))
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-ezb-initialize ()
|
||||
"Add EZBouncer convenience functions to ERC."
|
||||
(add-hook 'erc-server-NOTICE-functions 'erc-ezb-notice-autodetect))
|
||||
|
||||
(provide 'erc-ezbounce)
|
||||
|
||||
;; arch-tag: e972aa7b-a9f4-4d16-a489-074ec7a1002e
|
||||
;;; erc-ezbounce.el ends here
|
||||
197
lisp/erc/erc-fill.el
Normal file
197
lisp/erc/erc-fill.el
Normal file
|
|
@ -0,0 +1,197 @@
|
|||
;;; erc-fill.el --- Filling IRC messages in various ways
|
||||
|
||||
;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Andreas Fuchs <asf@void.at>
|
||||
;; Mario Lang <mlang@delysid.org>
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcFilling
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This package implements filling of messages sent and received. Use
|
||||
;; `erc-fill-mode' to switch it on. Customize `erc-fill-function' to
|
||||
;; change the style.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'erc-stamp); for the timestamp stuff
|
||||
|
||||
(defgroup erc-fill nil
|
||||
"Filling means to reformat long lines in different ways."
|
||||
:group 'erc)
|
||||
|
||||
;;;###autoload (autoload 'erc-fill-mode "erc-fill" nil t)
|
||||
(erc-define-minor-mode erc-fill-mode
|
||||
"Toggle ERC fill mode.
|
||||
With numeric arg, turn ERC fill mode on if and only if arg is
|
||||
positive. In ERC fill mode, messages in the channel buffers are
|
||||
filled."
|
||||
nil nil nil
|
||||
:global t :group 'erc-fill
|
||||
(if erc-fill-mode
|
||||
(erc-fill-enable)
|
||||
(erc-fill-disable)))
|
||||
|
||||
(defun erc-fill-enable ()
|
||||
"Setup hooks for `erc-fill-mode'."
|
||||
(interactive)
|
||||
(add-hook 'erc-insert-modify-hook 'erc-fill)
|
||||
(add-hook 'erc-send-modify-hook 'erc-fill))
|
||||
|
||||
(defun erc-fill-disable ()
|
||||
"Cleanup hooks, disable `erc-fill-mode'."
|
||||
(interactive)
|
||||
(remove-hook 'erc-insert-modify-hook 'erc-fill)
|
||||
(remove-hook 'erc-send-modify-hook 'erc-fill))
|
||||
|
||||
(defcustom erc-fill-prefix nil
|
||||
"Values used as `fill-prefix' for `erc-fill-variable'.
|
||||
nil means fill with space, a string means fill with this string."
|
||||
:group 'erc-fill
|
||||
:type '(choice (const nil) string))
|
||||
|
||||
(defcustom erc-fill-function 'erc-fill-variable
|
||||
"Function to use for filling messages.
|
||||
|
||||
Variable Filling with an `erc-fill-prefix' of nil:
|
||||
|
||||
<shortnick> this is a very very very long message with no
|
||||
meaning at all
|
||||
|
||||
Variable Filling with an `erc-fill-prefix' of four spaces:
|
||||
|
||||
<shortnick> this is a very very very long message with no
|
||||
meaning at all
|
||||
|
||||
Static Filling with `erc-fill-static-center' of 27:
|
||||
|
||||
<shortnick> foo bar baz
|
||||
<a-very-long-nick> foo bar baz quuuuux
|
||||
<shortnick> this is a very very very long message with no
|
||||
meaning at all
|
||||
|
||||
These two styles are implemented using `erc-fill-variable' and
|
||||
`erc-fill-static'. You can, of course, define your own filling
|
||||
function. Narrowing to the region in question is in effect while your
|
||||
function is called."
|
||||
:group 'erc-fill
|
||||
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
|
||||
(const :tag "Static Filling" erc-fill-static)
|
||||
function))
|
||||
|
||||
(defcustom erc-fill-static-center 27
|
||||
"Column around which all statically filled messages will be
|
||||
centered. This column denotes the point where the ' ' character
|
||||
between <nickname> and the entered text will be put, thus aligning
|
||||
nick names right and text left."
|
||||
:group 'erc-fill
|
||||
:type 'integer)
|
||||
|
||||
(defcustom erc-fill-variable-maximum-indentation 17
|
||||
"If we indent a line after a long nick, don't indent more then this
|
||||
characters. Set to nil to disable."
|
||||
:group 'erc-fill
|
||||
:type 'integer)
|
||||
|
||||
(defcustom erc-fill-column 78
|
||||
"The column at which a filled paragraph is broken."
|
||||
:group 'erc-fill
|
||||
:type 'integer)
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-fill ()
|
||||
"Fill a region using the function referenced in `erc-fill-function'.
|
||||
You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
|
||||
(unless (erc-string-invisible-p (buffer-substring (point-min) (point-max)))
|
||||
(when erc-fill-function
|
||||
(funcall erc-fill-function))))
|
||||
|
||||
(defun erc-fill-static ()
|
||||
"Fills a text such that messages start at column `erc-fill-static-center'."
|
||||
(save-match-data
|
||||
(goto-char (point-min))
|
||||
(looking-at "^\\(\\S-+\\)")
|
||||
(let ((nick (match-string 1)))
|
||||
(let ((fill-column (- erc-fill-column (erc-timestamp-offset)))
|
||||
(fill-prefix (make-string erc-fill-static-center 32)))
|
||||
(insert (make-string (max 0 (- erc-fill-static-center
|
||||
(length nick) 1))
|
||||
32))
|
||||
(erc-fill-regarding-timestamp))
|
||||
(erc-restore-text-properties))))
|
||||
|
||||
(defun erc-fill-variable ()
|
||||
"Fill from `point-min' to `point-max'."
|
||||
(let ((fill-prefix erc-fill-prefix)
|
||||
(fill-column (or erc-fill-column fill-column)))
|
||||
(goto-char (point-min))
|
||||
(if fill-prefix
|
||||
(let ((first-line-offset (make-string (erc-timestamp-offset) 32)))
|
||||
(insert first-line-offset)
|
||||
(fill-region (point-min) (point-max) t t)
|
||||
(goto-char (point-min))
|
||||
(delete-char (length first-line-offset)))
|
||||
(save-match-data
|
||||
(let* ((nickp (looking-at "^\\(\\S-+\\)"))
|
||||
(nick (if nickp
|
||||
(match-string 1)
|
||||
""))
|
||||
(fill-column (- erc-fill-column (erc-timestamp-offset)))
|
||||
(fill-prefix (make-string (min (+ 1 (length nick))
|
||||
(- fill-column 1)
|
||||
(or erc-fill-variable-maximum-indentation
|
||||
fill-column))
|
||||
32)))
|
||||
(erc-fill-regarding-timestamp))))
|
||||
(erc-restore-text-properties)))
|
||||
|
||||
(defun erc-fill-regarding-timestamp ()
|
||||
"Fills a text such that messages start at column `erc-fill-static-center'."
|
||||
(fill-region (point-min) (point-max) t t)
|
||||
(goto-char (point-min))
|
||||
(forward-line)
|
||||
(indent-rigidly (point) (point-max) (erc-timestamp-offset)))
|
||||
|
||||
(defun erc-timestamp-offset ()
|
||||
"Get length of timestamp if inserted left."
|
||||
(if (and (boundp 'erc-timestamp-format)
|
||||
erc-timestamp-format
|
||||
(eq erc-insert-timestamp-function 'erc-insert-timestamp-left)
|
||||
(not erc-hide-timestamps))
|
||||
(length (format-time-string erc-timestamp-format))
|
||||
0))
|
||||
|
||||
(defun erc-restore-text-properties ()
|
||||
"Restore the property 'erc-parsed for the region."
|
||||
(let* ((parsed-posn (text-property-not-all (point-min) (point-max)
|
||||
'erc-parsed nil))
|
||||
(parsed-prop (when parsed-posn
|
||||
(get-text-property parsed-posn 'erc-parsed))))
|
||||
(put-text-property (point-min) (point-max) 'erc-parsed parsed-prop)))
|
||||
|
||||
(provide 'erc-fill)
|
||||
|
||||
;;; erc-fill.el ends here
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 89224581-c2c2-4e26-92e5-e3a390dc516a
|
||||
522
lisp/erc/erc-goodies.el
Normal file
522
lisp/erc/erc-goodies.el
Normal file
|
|
@ -0,0 +1,522 @@
|
|||
;; erc-goodies.el --- Collection of ERC modules
|
||||
|
||||
;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation
|
||||
|
||||
;; Author: Jorgen Schaefer <forcer@forcix.cx>
|
||||
|
||||
;; Most code is taken verbatim from erc.el, see there for the original
|
||||
;; authors.
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This provides some small but still useful modes for ERC.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
|
||||
;; Imenu Autoload
|
||||
(add-hook 'erc-mode-hook
|
||||
(lambda ()
|
||||
(setq imenu-create-index-function 'erc-create-imenu-index)))
|
||||
(autoload 'erc-create-imenu-index "erc-imenu" "Imenu index creation function")
|
||||
|
||||
;;; Automatically scroll to bottom
|
||||
(defcustom erc-input-line-position nil
|
||||
"Specify where to position the input line when using `erc-scroll-to-bottom'.
|
||||
|
||||
This should be an integer specifying the line of the buffer on which
|
||||
the input line should stay. A value of \"-1\" would keep the input
|
||||
line positioned on the last line in the buffer. This is passed as an
|
||||
argument to `recenter'."
|
||||
:group 'erc-display
|
||||
:type '(choice integer (const nil)))
|
||||
|
||||
(define-erc-module scrolltobottom nil
|
||||
"This mode causes the prompt to stay at the end of the window.
|
||||
You have to activate or deactivate it in already created windows
|
||||
separately."
|
||||
((add-hook 'erc-mode-hook 'erc-add-scroll-to-bottom))
|
||||
((remove-hook 'erc-mode-hook 'erc-add-scroll-to-bottom)))
|
||||
|
||||
(defun erc-add-scroll-to-bottom ()
|
||||
"A hook function for `erc-mode-hook' to recenter output at bottom of window.
|
||||
|
||||
If you find that ERC hangs when using this function, try customizing
|
||||
the value of `erc-input-line-position'.
|
||||
|
||||
This works whenever scrolling happens, so it's added to
|
||||
`window-scroll-functions' rather than `erc-insert-post-hook'."
|
||||
;;(make-local-hook 'window-scroll-functions)
|
||||
(add-hook 'window-scroll-functions 'erc-scroll-to-bottom nil t))
|
||||
|
||||
(defun erc-scroll-to-bottom (window display-start)
|
||||
"Recenter WINDOW so that `point' is on the last line.
|
||||
|
||||
This is added to `window-scroll-functions' by `erc-add-scroll-to-bottom'.
|
||||
|
||||
You can control which line is recentered to by customizing the
|
||||
variable `erc-input-line-position'.
|
||||
|
||||
DISPLAY-START is ignored."
|
||||
(if (and window (window-live-p window))
|
||||
;; Temporarily bind resize-mini-windows to nil so that users who have it
|
||||
;; set to a non-nil value will not suffer from premature minibuffer
|
||||
;; shrinkage due to the below recenter call. I have no idea why this
|
||||
;; works, but it solves the problem, and has no negative side effects.
|
||||
;; (Fran Litterio, 2003/01/07)
|
||||
(let ((resize-mini-windows nil))
|
||||
(save-selected-window
|
||||
(select-window window)
|
||||
(save-restriction
|
||||
(widen)
|
||||
(when (and erc-insert-marker
|
||||
;; we're editing a line. Scroll.
|
||||
(> (point) erc-insert-marker))
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(recenter (or erc-input-line-position -1))
|
||||
(sit-for 0))))))))
|
||||
|
||||
;;; Make read only
|
||||
(define-erc-module readonly nil
|
||||
"This mode causes all inserted text to be read-only."
|
||||
((add-hook 'erc-insert-post-hook 'erc-make-read-only)
|
||||
(add-hook 'erc-send-post-hook 'erc-make-read-only))
|
||||
((remove-hook 'erc-insert-post-hook 'erc-make-read-only)
|
||||
(remove-hook 'erc-send-post-hook 'erc-make-read-only)))
|
||||
|
||||
(defun erc-make-read-only ()
|
||||
"Make all the text in the current buffer read-only.
|
||||
Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
|
||||
(put-text-property (point-min) (point-max) 'read-only t)
|
||||
(put-text-property (point-min) (point-max) 'front-sticky t)
|
||||
(put-text-property (point-min) (point-max) 'rear-nonsticky t))
|
||||
|
||||
;; Distingush non-commands
|
||||
(defvar erc-noncommands-list '(erc-cmd-ME
|
||||
erc-cmd-COUNTRY
|
||||
erc-cmd-SV
|
||||
erc-cmd-SM
|
||||
erc-cmd-SMV
|
||||
erc-cmd-LASTLOG)
|
||||
"List of commands that are aliases for CTCP ACTION or for erc messages.
|
||||
|
||||
If a command's function symbol is in this list, the typed command
|
||||
does not appear in the ERC buffer after the user presses ENTER.")
|
||||
|
||||
(define-erc-module noncommands nil
|
||||
"This mode distinguishies non-commands.
|
||||
Commands listed in `erc-insert-this' know how to display
|
||||
themselves."
|
||||
((add-hook 'erc-send-pre-hook 'erc-send-distinguish-noncommands))
|
||||
((remove-hook 'erc-send-pre-hook 'erc-send-distinguish-noncommands)))
|
||||
|
||||
(defun erc-send-distinguish-noncommands (str)
|
||||
"If STR is an ERC non-command, set `erc-insert-this' to nil."
|
||||
(let* ((command (erc-extract-command-from-line str))
|
||||
(cmd-fun (and command
|
||||
(car command))))
|
||||
(when (and cmd-fun
|
||||
(not (string-match "\n.+$" str))
|
||||
(memq cmd-fun erc-noncommands-list))
|
||||
(setq erc-insert-this nil))))
|
||||
|
||||
;;; IRC control character processing.
|
||||
(defgroup erc-control-characters nil
|
||||
"Dealing with control characters"
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-interpret-controls-p t
|
||||
"*If non-nil, display IRC colours and other highlighting effects.
|
||||
|
||||
If this is set to the symbol `remove', ERC removes all IRC colors and
|
||||
highlighting effects. When this variable is non-nil, it can cause Emacs to run
|
||||
slowly on systems lacking sufficient CPU speed. In chatty channels, or in an
|
||||
emergency (message flood) it can be turned off to save processing time. See
|
||||
`erc-toggle-interpret-controls'."
|
||||
:group 'erc-control-characters
|
||||
:type '(choice (const :tag "Highlight control characters" t)
|
||||
(const :tag "Remove control characters" remove)
|
||||
(const :tag "Display raw control characters" nil)))
|
||||
|
||||
(defcustom erc-interpret-mirc-color nil
|
||||
"*If non-nil, erc will interpret mIRC color codes."
|
||||
:group 'erc-control-characters
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-beep-p nil
|
||||
"Beep if C-g is in the server message.
|
||||
The value `erc-interpret-controls-p' must also be t for this to work."
|
||||
:group 'erc-control-characters
|
||||
:type 'boolean)
|
||||
|
||||
(defface erc-bold-face '((t (:bold t)))
|
||||
"ERC bold face."
|
||||
:group 'erc-faces)
|
||||
(defface erc-inverse-face
|
||||
'((t (:foreground "White" :background "Black")))
|
||||
"ERC inverse face."
|
||||
:group 'erc-faces)
|
||||
(defface erc-underline-face '((t (:underline t)))
|
||||
"ERC underline face."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface fg:erc-color-face0 '((t (:foreground "White")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face1 '((t (:foreground "black")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face2 '((t (:foreground "blue4")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face3 '((t (:foreground "green4")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face4 '((t (:foreground "red")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face5 '((t (:foreground "brown")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face6 '((t (:foreground "purple")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face7 '((t (:foreground "orange")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face8 '((t (:foreground "yellow")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face9 '((t (:foreground "green")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face10 '((t (:foreground "lightblue1")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face11 '((t (:foreground "cyan")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face12 '((t (:foreground "blue")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face13 '((t (:foreground "deeppink")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face14 '((t (:foreground "gray50")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface fg:erc-color-face15 '((t (:foreground "gray90")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface bg:erc-color-face0 '((t (:background "White")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face1 '((t (:background "black")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face2 '((t (:background "blue4")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face3 '((t (:background "green4")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face4 '((t (:background "red")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face5 '((t (:background "brown")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face6 '((t (:background "purple")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face7 '((t (:background "orange")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face8 '((t (:background "yellow")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face9 '((t (:background "green")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face10 '((t (:background "lightblue1")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face11 '((t (:background "cyan")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face12 '((t (:background "blue")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face13 '((t (:background "deeppink")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face14 '((t (:background "gray50")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
(defface bg:erc-color-face15 '((t (:background "gray90")))
|
||||
"ERC face."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defun erc-get-bg-color-face (n)
|
||||
"Fetches the right face for background color N (0-15)."
|
||||
(if (stringp n) (setq n (string-to-number n)))
|
||||
(if (not (numberp n))
|
||||
(progn
|
||||
(message "erc-get-bg-color-face: n is NaN: %S" n)
|
||||
(beep)
|
||||
'default)
|
||||
(when (> n 16)
|
||||
(erc-log (format " Wrong color: %s" n))
|
||||
(setq n (mod n 16)))
|
||||
(cond
|
||||
((and (>= n 0) (< n 16))
|
||||
(intern (concat "bg:erc-color-face" (number-to-string n))))
|
||||
(t (erc-log (format " Wrong color: %s" n)) 'default))))
|
||||
|
||||
(defun erc-get-fg-color-face (n)
|
||||
"Fetches the right face for foreground color N (0-15)."
|
||||
(if (stringp n) (setq n (string-to-number n)))
|
||||
(if (not (numberp n))
|
||||
(progn
|
||||
(message "erc-get-fg-color-face: n is NaN: %S" n)
|
||||
(beep)
|
||||
'default)
|
||||
(when (> n 16)
|
||||
(erc-log (format " Wrong color: %s" n))
|
||||
(setq n (mod n 16)))
|
||||
(cond
|
||||
((and (>= n 0) (< n 16))
|
||||
(intern (concat "fg:erc-color-face" (number-to-string n))))
|
||||
(t (erc-log (format " Wrong color: %s" n)) 'default))))
|
||||
|
||||
(define-erc-module irccontrols nil
|
||||
"This mode enables the interpretation of IRC control chars."
|
||||
((add-hook 'erc-insert-modify-hook 'erc-controls-highlight)
|
||||
(add-hook 'erc-send-modify-hook 'erc-controls-highlight))
|
||||
((remove-hook 'erc-insert-modify-hook 'erc-controls-highlight)
|
||||
(remove-hook 'erc-send-modify-hook 'erc-controls-highlight)))
|
||||
|
||||
(defun erc-controls-interpret (str)
|
||||
"Return a copy of STR after dealing with IRC control characters.
|
||||
See `erc-interpret-controls-p' and `erc-interpret-mirc-color' for options."
|
||||
(when str
|
||||
(let ((s str))
|
||||
(cond ((eq erc-interpret-controls-p 'remove)
|
||||
(erc-controls-strip s))
|
||||
(erc-interpret-controls-p
|
||||
(let ((boldp nil)
|
||||
(inversep nil)
|
||||
(underlinep nil)
|
||||
(fg nil)
|
||||
(bg nil))
|
||||
(while (string-match erc-controls-highlight-regexp s)
|
||||
(let ((control (match-string 1 s))
|
||||
(fg-color (match-string 2 s))
|
||||
(bg-color (match-string 4 s))
|
||||
(start (match-beginning 0))
|
||||
(end (+ (match-beginning 0)
|
||||
(length (match-string 5 s)))))
|
||||
(setq s (erc-replace-match-subexpression-in-string
|
||||
"" s control 1 start))
|
||||
(cond ((and erc-interpret-mirc-color (or fg-color bg-color))
|
||||
(setq fg fg-color)
|
||||
(setq bg bg-color))
|
||||
((string= control "\C-b")
|
||||
(setq boldp (not boldp)))
|
||||
((string= control "\C-v")
|
||||
(setq inversep (not inversep)))
|
||||
((string= control "\C-_")
|
||||
(setq underlinep (not underlinep)))
|
||||
((string= control "\C-c")
|
||||
(setq fg nil
|
||||
bg nil))
|
||||
((string= control "\C-g")
|
||||
(when erc-beep-p
|
||||
(ding)))
|
||||
((string= control "\C-o")
|
||||
(setq boldp nil
|
||||
inversep nil
|
||||
underlinep nil
|
||||
fg nil
|
||||
bg nil))
|
||||
(t nil))
|
||||
(erc-controls-propertize
|
||||
start end boldp inversep underlinep fg bg s)))
|
||||
s))
|
||||
(t s)))))
|
||||
|
||||
(defun erc-controls-strip (str)
|
||||
"Return a copy of STR with all IRC control characters removed."
|
||||
(when str
|
||||
(let ((s str))
|
||||
(while (string-match erc-controls-remove-regexp s)
|
||||
(setq s (replace-match "" nil nil s)))
|
||||
s)))
|
||||
|
||||
(defvar erc-controls-remove-regexp
|
||||
"\C-b\\|\C-_\\|\C-v\\|\C-g\\|\C-o\\|\C-c[0-9]?[0-9]?\\(,[0-9][0-9]?\\)?"
|
||||
"Regular expression which matches control characters to remove.")
|
||||
|
||||
(defvar erc-controls-highlight-regexp
|
||||
(concat "\\(\C-b\\|\C-v\\|\C-_\\|\C-g\\|\C-o\\|"
|
||||
"\C-c\\([0-9][0-9]?\\)?\\(,\\([0-9][0-9]?\\)\\)?\\)"
|
||||
"\\([^\C-b\C-v\C-_\C-c\C-g\C-o\n]*\\)")
|
||||
"Regular expression which matches control chars and the text to highlight.")
|
||||
|
||||
(defun erc-controls-highlight ()
|
||||
"Highlight IRC control chars in the buffer.
|
||||
This is useful for `erc-insert-modify-hook' and
|
||||
`erc-send-modify-hook'. Also see `erc-interpret-controls-p' and
|
||||
`erc-interpret-mirc-color'."
|
||||
(goto-char (point-min))
|
||||
(cond ((eq erc-interpret-controls-p 'remove)
|
||||
(while (re-search-forward erc-controls-remove-regexp nil t)
|
||||
(replace-match "")))
|
||||
(erc-interpret-controls-p
|
||||
(let ((boldp nil)
|
||||
(inversep nil)
|
||||
(underlinep nil)
|
||||
(fg nil)
|
||||
(bg nil))
|
||||
(while (re-search-forward erc-controls-highlight-regexp nil t)
|
||||
(let ((control (match-string 1))
|
||||
(fg-color (match-string 2))
|
||||
(bg-color (match-string 4))
|
||||
(start (match-beginning 0))
|
||||
(end (+ (match-beginning 0) (length (match-string 5)))))
|
||||
(replace-match "" nil nil nil 1)
|
||||
(cond ((and erc-interpret-mirc-color (or fg-color bg-color))
|
||||
(setq fg fg-color)
|
||||
(setq bg bg-color))
|
||||
((string= control "\C-b")
|
||||
(setq boldp (not boldp)))
|
||||
((string= control "\C-v")
|
||||
(setq inversep (not inversep)))
|
||||
((string= control "\C-_")
|
||||
(setq underlinep (not underlinep)))
|
||||
((string= control "\C-c")
|
||||
(setq fg nil
|
||||
bg nil))
|
||||
((string= control "\C-g")
|
||||
(when erc-beep-p
|
||||
(ding)))
|
||||
((string= control "\C-o")
|
||||
(setq boldp nil
|
||||
inversep nil
|
||||
underlinep nil
|
||||
fg nil
|
||||
bg nil))
|
||||
(t nil))
|
||||
(erc-controls-propertize start end
|
||||
boldp inversep underlinep fg bg)))))
|
||||
(t nil)))
|
||||
|
||||
(defun erc-controls-propertize (from to boldp inversep underlinep fg bg
|
||||
&optional str)
|
||||
"Prepend properties from IRC control characters between FROM and TO.
|
||||
If optional argument STR is provided, apply to STR, otherwise prepend properties
|
||||
to a region in the current buffer."
|
||||
(font-lock-prepend-text-property
|
||||
from
|
||||
to
|
||||
'face
|
||||
(append (if boldp
|
||||
'(erc-bold-face)
|
||||
nil)
|
||||
(if inversep
|
||||
'(erc-inverse-face)
|
||||
nil)
|
||||
(if underlinep
|
||||
'(erc-underline-face)
|
||||
nil)
|
||||
(if fg
|
||||
(list (erc-get-fg-color-face fg))
|
||||
nil)
|
||||
(if bg
|
||||
(list (erc-get-bg-color-face bg))
|
||||
nil))
|
||||
str)
|
||||
str)
|
||||
|
||||
(defun erc-toggle-interpret-controls (&optional arg)
|
||||
"Toggle interpretation of control sequences in messages.
|
||||
|
||||
If ARG is positive, interpretation is turned on.
|
||||
Else interpretation is turned off."
|
||||
(interactive "P")
|
||||
(cond ((and (numberp arg) (> arg 0))
|
||||
(setq erc-interpret-controls-p t))
|
||||
(arg (setq erc-interpret-controls-p nil))
|
||||
(t (setq erc-interpret-controls-p (not erc-interpret-controls-p))))
|
||||
(message "ERC color interpretation %s"
|
||||
(if erc-interpret-controls-p "ON" "OFF")))
|
||||
|
||||
;; Smiley
|
||||
(define-erc-module smiley nil
|
||||
"This mode translates text-smileys such as :-) into pictures.
|
||||
This requires the function `smiley-region', which is defined in
|
||||
smiley.el, which is part of Gnus."
|
||||
((add-hook 'erc-insert-modify-hook 'erc-smiley)
|
||||
(add-hook 'erc-send-modify-hook 'erc-smiley))
|
||||
((remove-hook 'erc-insert-modify-hook 'erc-smiley)
|
||||
(remove-hook 'erc-send-modify-hook 'erc-smiley)))
|
||||
|
||||
(defun erc-smiley ()
|
||||
"Smilify a region.
|
||||
This function should be used with `erc-insert-modify-hook'."
|
||||
(when (fboundp 'smiley-region)
|
||||
(smiley-region (point-min) (point-max))))
|
||||
|
||||
;; Unmorse
|
||||
(define-erc-module unmorse nil
|
||||
"This mode causes morse code in the current channel to be unmorsed."
|
||||
((add-hook 'erc-insert-modify-hook 'erc-unmorse))
|
||||
((remove-hook 'erc-insert-modify-hook 'erc-unmorse)))
|
||||
|
||||
(defun erc-unmorse ()
|
||||
"Unmorse some text.
|
||||
Add this to `erc-insert-modify-hook' if you happen to be on a
|
||||
channel that has weird people talking in morse to each other.
|
||||
|
||||
See also `unmorse-region'."
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "[.-]+\\([.-]+[/ ]\\)+[.-]+" nil t)
|
||||
(unmorse-region (match-beginning 0) (match-end 0))))
|
||||
|
||||
;;; erc-occur
|
||||
(defun erc-occur (string &optional proc)
|
||||
"Search for STRING in all buffers related to current server.
|
||||
If called interactively and prefix argument is given, search on all connected
|
||||
servers. If called from a program, PROC specifies the server process."
|
||||
(interactive
|
||||
(list (read-string "Search for: ")
|
||||
(if current-prefix-arg
|
||||
nil erc-server-process)))
|
||||
(if (fboundp 'multi-occur)
|
||||
(multi-occur (erc-buffer-list nil proc) string)
|
||||
(error "`multi-occur' is not defined as a function")))
|
||||
|
||||
(provide 'erc-goodies)
|
||||
|
||||
;; arch-tag: d987ae26-9e28-4c72-9596-e617309fb582
|
||||
;;; erc-goodies.el ends here
|
||||
192
lisp/erc/erc-ibuffer.el
Normal file
192
lisp/erc/erc-ibuffer.el
Normal file
|
|
@ -0,0 +1,192 @@
|
|||
;;; erc-ibuffer.el --- ibuffer integration with ERC
|
||||
|
||||
;; Copyright (C) 2002, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
;; Keywords: comm
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcIbuffer
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file contains code related to Ibuffer and ERC. Totally alpha,
|
||||
;; needs work. Usage: Type / C-e C-h when in Ibuffer-mode to see new
|
||||
;; limiting commands
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ibuffer)
|
||||
(require 'ibuf-ext)
|
||||
(require 'erc)
|
||||
|
||||
(defgroup erc-ibuffer nil
|
||||
"The Ibuffer group for ERC."
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-ibuffer-keyword-char ?k
|
||||
"Char used to indicate a channel which had keyword traffic lately (hidden)."
|
||||
:group 'erc-ibuffer
|
||||
:type 'character)
|
||||
(defcustom erc-ibuffer-pal-char ?p
|
||||
"Char used to indicate a channel which had pal traffic lately (hidden)."
|
||||
:group 'erc-ibuffer
|
||||
:type 'character)
|
||||
(defcustom erc-ibuffer-fool-char ?f
|
||||
"Char used to indicate a channel which had fool traffic lately (hidden)."
|
||||
:group 'erc-ibuffer
|
||||
:type 'character)
|
||||
(defcustom erc-ibuffer-dangerous-host-char ?d
|
||||
"Char used to indicate a channel which had dangerous-host traffic lately
|
||||
\(hidden)."
|
||||
:group 'erc-ibuffer
|
||||
:type 'character)
|
||||
|
||||
(define-ibuffer-filter erc-server
|
||||
"Toggle current view to buffers which are related to ERC servers."
|
||||
(:description "erc servers"
|
||||
:reader
|
||||
(let ((regexp
|
||||
(read-from-minibuffer "Limit by server (regexp) (RET for all): ")))
|
||||
(if (string= regexp "")
|
||||
".*"
|
||||
regexp)))
|
||||
(with-current-buffer buf
|
||||
(and (eq major-mode 'erc-mode)
|
||||
(string-match qualifier (or erc-server-announced-name
|
||||
erc-session-server)))))
|
||||
|
||||
(define-ibuffer-column erc-modified (:name "M")
|
||||
(if (and (boundp 'erc-track-mode)
|
||||
erc-track-mode)
|
||||
(let ((entry (assq (current-buffer) erc-modified-channels-alist)))
|
||||
(if entry
|
||||
(if (> (length entry) 1)
|
||||
(cond ((eq 'pal (nth 1 entry))
|
||||
(string erc-ibuffer-pal-char))
|
||||
((eq 'fool (nth 1 entry))
|
||||
(string erc-ibuffer-fool-char))
|
||||
((eq 'keyword (nth 1 entry))
|
||||
(string erc-ibuffer-keyword-char))
|
||||
((eq 'dangerous-host (nth 1 entry))
|
||||
(string erc-ibuffer-dangerous-host-char))
|
||||
(t "$"))
|
||||
(string ibuffer-modified-char))
|
||||
" "))
|
||||
" "))
|
||||
|
||||
(define-ibuffer-column erc-server-name (:name "Server")
|
||||
(if (and (boundp 'erc-server-process) (processp erc-server-process))
|
||||
(with-current-buffer (process-buffer erc-server-process)
|
||||
(or erc-server-announced-name erc-session-server))
|
||||
""))
|
||||
|
||||
(define-ibuffer-column erc-target (:name "Target")
|
||||
(if (eq major-mode 'erc-mode)
|
||||
(cond ((and (boundp 'erc-server-process) (processp erc-server-process)
|
||||
(eq (current-buffer) (process-buffer erc-server-process)))
|
||||
(concat "Server " erc-session-server ":"
|
||||
(erc-port-to-string erc-session-port)))
|
||||
((erc-channel-p (erc-default-target))
|
||||
(concat (erc-default-target)))
|
||||
((erc-default-target)
|
||||
(concat "Query: " (erc-default-target)))
|
||||
(t "(parted)"))
|
||||
(buffer-name)))
|
||||
|
||||
(define-ibuffer-column erc-topic (:name "Topic")
|
||||
(if (and (eq major-mode 'erc-mode)
|
||||
erc-channel-topic)
|
||||
(erc-controls-interpret erc-channel-topic)
|
||||
""))
|
||||
|
||||
(define-ibuffer-column
|
||||
erc-members (:name "Users")
|
||||
(if (and (eq major-mode 'erc-mode)
|
||||
(boundp 'erc-channel-users)
|
||||
(hash-table-p erc-channel-users)
|
||||
(> (hash-table-size erc-channel-users) 0))
|
||||
(number-to-string (hash-table-size erc-channel-users))
|
||||
""))
|
||||
|
||||
(define-ibuffer-column erc-away (:name "A")
|
||||
(if (and (boundp 'erc-server-process)
|
||||
(processp erc-server-process)
|
||||
(with-current-buffer (process-buffer erc-server-process)
|
||||
erc-away))
|
||||
"A"
|
||||
" "))
|
||||
|
||||
(define-ibuffer-column
|
||||
erc-op (:name "O")
|
||||
(if (and (eq major-mode 'erc-mode)
|
||||
(erc-channel-user-op-p (erc-current-nick)))
|
||||
"@"
|
||||
" "))
|
||||
|
||||
(define-ibuffer-column erc-voice (:name "V")
|
||||
(if (and (eq major-mode 'erc-mode)
|
||||
(erc-channel-user-voice-p (erc-current-nick)))
|
||||
"+"
|
||||
" "))
|
||||
|
||||
(define-ibuffer-column erc-channel-modes (:name "Mode")
|
||||
(if (and (eq major-mode 'erc-mode)
|
||||
(or (> (length erc-channel-modes) 0)
|
||||
erc-channel-user-limit))
|
||||
(concat (apply 'concat
|
||||
"(+" erc-channel-modes)
|
||||
(if erc-channel-user-limit
|
||||
(format "l %d" erc-channel-user-limit)
|
||||
"")
|
||||
")")
|
||||
(if (not (eq major-mode 'erc-mode))
|
||||
mode-name
|
||||
"")))
|
||||
|
||||
(define-ibuffer-column erc-nick (:name "Nick")
|
||||
(if (eq major-mode 'erc-mode)
|
||||
(erc-current-nick)
|
||||
""))
|
||||
|
||||
(defvar erc-ibuffer-formats
|
||||
'((mark erc-modified erc-away erc-op erc-voice " " (erc-nick 8 8) " "
|
||||
(erc-target 18 40) (erc-members 5 5 :center)
|
||||
(erc-channel-modes 6 16 :center) " " (erc-server-name 20 30) " "
|
||||
(erc-topic 10 -1))
|
||||
(mark erc-modified erc-away erc-op erc-voice " " (erc-target 18 40)
|
||||
(erc-members 5 5 :center) (erc-channel-modes 9 20 :center) " "
|
||||
(erc-topic 10 -1))))
|
||||
(setq ibuffer-formats (append ibuffer-formats erc-ibuffer-formats))
|
||||
|
||||
(defvar erc-ibuffer-limit-map nil
|
||||
"Prefix keymap to use for ERC related limiting.")
|
||||
(define-prefix-command 'erc-ibuffer-limit-map)
|
||||
(define-key 'erc-ibuffer-limit-map (kbd "s") 'ibuffer-limit-by-erc-server)
|
||||
(define-key ibuffer-mode-map (kbd "/ \C-e") 'erc-ibuffer-limit-map)
|
||||
|
||||
(provide 'erc-ibuffer)
|
||||
|
||||
;;; erc-ibuffer.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: fbad56a5-8595-45e0-a8c8-d8bb91e26944
|
||||
87
lisp/erc/erc-identd.el
Normal file
87
lisp/erc/erc-identd.el
Normal file
|
|
@ -0,0 +1,87 @@
|
|||
;;; erc-identd.el --- RFC1413 (identd authentication protocol) server
|
||||
|
||||
;; Copyright (C) 2003 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: John Wiegley <johnw@gnu.org>
|
||||
;; Keywords: comm, processes
|
||||
|
||||
;; 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:
|
||||
|
||||
;; You can have a local identd server (running on port 8113; I use DNAT
|
||||
;; to bind 113->8113) if you add this to .emacs.el:
|
||||
|
||||
;; (add-hook 'erc-connect-pre-hook 'erc-identd-start)
|
||||
;; (add-hook 'erc-disconnected-hook 'erc-identd-stop)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defvar erc-identd-process nil)
|
||||
|
||||
(defun erc-identd-filter (proc string)
|
||||
"This filter implements RFC1413 (identd authentication protocol)."
|
||||
(let ((erc-identd-process proc))
|
||||
(when (string-match "\\([0-9]+\\)\\s-*,\\s-*\\([0-9]+\\)" string)
|
||||
(let ((port-on-server (match-string 1 string))
|
||||
(port-on-client (match-string 2 string)))
|
||||
(send-string erc-identd-process
|
||||
(format "%s, %s : USERID : %s : %s\n"
|
||||
port-on-server port-on-client
|
||||
system-type (user-login-name)))
|
||||
(process-send-eof erc-identd-process)))))
|
||||
|
||||
(defun erc-identd-start (&optional port)
|
||||
"Start an identd server listening to port 8113.
|
||||
Port 113 (auth) will need to be redirected to port 8113 on your
|
||||
machine -- using iptables, or a program like redir which can be
|
||||
run from inetd. The idea is to provide a simple identd server
|
||||
when you need one, without having to install one globally on your
|
||||
system."
|
||||
(interactive (list (read-string "Serve identd requests on port: " "8113")))
|
||||
(if (null port)
|
||||
(setq port 8113)
|
||||
(if (stringp port)
|
||||
(setq port (string-to-number port))))
|
||||
(if erc-identd-process
|
||||
(delete-process erc-identd-process))
|
||||
(if (fboundp 'make-network-process)
|
||||
(setq erc-identd-process
|
||||
(make-network-process :name "identd"
|
||||
:buffer (generate-new-buffer "identd")
|
||||
:service port :server t :noquery t
|
||||
:filter 'erc-identd-filter))
|
||||
(open-network-stream-server "identd" (generate-new-buffer "identd")
|
||||
port nil 'erc-identd-filter)))
|
||||
|
||||
(defun erc-identd-stop (&rest ignore)
|
||||
(interactive)
|
||||
(when erc-identd-process
|
||||
(delete-process erc-identd-process)
|
||||
(setq erc-identd-process nil)))
|
||||
|
||||
(provide 'erc-identd)
|
||||
|
||||
;;; erc-identd.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: e0b5f926-0f35-40b9-8ddb-ca06b62a7544
|
||||
143
lisp/erc/erc-imenu.el
Normal file
143
lisp/erc/erc-imenu.el
Normal file
|
|
@ -0,0 +1,143 @@
|
|||
;;; erc-imenu.el -- Imenu support for ERC
|
||||
|
||||
;; Copyright (C) 2001, 2002, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
;; Keywords: comm
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcImenu
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file contains code related to Ibuffer and ERC. Totally alpha,
|
||||
;; needs work. Usage: Type / C-e C-h when in Ibuffer-mode to see new
|
||||
;; limiting commands
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
|
||||
;; This file is not part of GNU Emacs. But the same license applies.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package defines the function `erc-create-imenu-index'. ERC
|
||||
;; uses this for `imenu-create-index-function', and autoloads it.
|
||||
;; Therefore, nothing needs to be done to use this package.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'imenu)
|
||||
|
||||
(defun erc-unfill-notice ()
|
||||
"Return text from point to a computed end as a string unfilled.
|
||||
Don't rely on this function, read it first!"
|
||||
(let ((str (buffer-substring
|
||||
(save-excursion
|
||||
(re-search-forward (regexp-quote erc-notice-prefix)))
|
||||
(progn
|
||||
(while (save-excursion
|
||||
(forward-line 1)
|
||||
(looking-at " "))
|
||||
(forward-line 1))
|
||||
(end-of-line) (point)))))
|
||||
(with-temp-buffer
|
||||
(insert str)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\n +" nil t)
|
||||
(replace-match " "))
|
||||
(buffer-substring (point-min) (point-max)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-create-imenu-index ()
|
||||
(let ((index-alist '())
|
||||
(notice-alist '())
|
||||
(join-alist '())
|
||||
(left-alist '())
|
||||
(quit-alist '())
|
||||
(message-alist '())
|
||||
(mode-change-alist '())
|
||||
(topic-change-alist '())
|
||||
prev-pos)
|
||||
(goto-char (point-max))
|
||||
(imenu-progress-message prev-pos 0)
|
||||
(while (if (bolp)
|
||||
(> (forward-line -1)
|
||||
-1)
|
||||
(progn (forward-line 0)
|
||||
t))
|
||||
(imenu-progress-message prev-pos nil t)
|
||||
(save-match-data
|
||||
(when (looking-at (concat (regexp-quote erc-notice-prefix)
|
||||
"\\(.+\\)$"))
|
||||
(let ((notice-text ;; Ugly hack, but seems to work.
|
||||
(save-excursion (erc-unfill-notice)))
|
||||
(pos (point)))
|
||||
(push (cons notice-text pos) notice-alist)
|
||||
(or
|
||||
(when (string-match "^\\(.*\\) has joined channel" notice-text)
|
||||
(push (cons (match-string 1 notice-text) pos) join-alist))
|
||||
(when (string-match "^\\(.+\\) has left channel" notice-text)
|
||||
(push (cons (match-string 1 notice-text) pos) left-alist))
|
||||
(when (string-match "^\\(.+\\) has quit\\(.*\\)$" notice-text)
|
||||
(push (cons (concat (match-string 1 notice-text)
|
||||
(match-string 2 notice-text))
|
||||
(point))
|
||||
quit-alist))
|
||||
(when (string-match
|
||||
"^\\(\\S-+\\) (.+) has changed mode for \\S-+ to \\(.*\\)$"
|
||||
notice-text)
|
||||
(push (cons (concat (match-string 1 notice-text) ": "
|
||||
(match-string 2 notice-text))
|
||||
(point))
|
||||
mode-change-alist))
|
||||
(when (string-match
|
||||
"^\\(\\S-+\\) (.+) has set the topic for \\S-+: \\(.*\\)$"
|
||||
notice-text)
|
||||
(push (cons (concat (match-string 1 notice-text) ": "
|
||||
(match-string 2 notice-text)) pos)
|
||||
topic-change-alist)))))
|
||||
(when (looking-at "<\\(\\S-+\\)> \\(.+\\)$")
|
||||
(let ((from (match-string 1))
|
||||
(message-text (match-string 2)))
|
||||
(push (cons (concat from ": " message-text) (point))
|
||||
message-alist)))))
|
||||
(and notice-alist (push (cons "notices" notice-alist) index-alist))
|
||||
(and join-alist (push (cons "joined" join-alist) index-alist))
|
||||
(and left-alist (push (cons "parted" left-alist) index-alist))
|
||||
(and quit-alist (push (cons "quit" quit-alist) index-alist))
|
||||
(and mode-change-alist (push (cons "mode-change" mode-change-alist)
|
||||
index-alist))
|
||||
(and message-alist (push (cons "messages" message-alist) index-alist))
|
||||
(and topic-change-alist (push (cons "topic-change" topic-change-alist)
|
||||
index-alist))
|
||||
index-alist))
|
||||
|
||||
(provide 'erc-imenu)
|
||||
|
||||
;;; erc-imenu.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 35c69082-ca29-43f7-a050-8da5f400de81
|
||||
213
lisp/erc/erc-lang.el
Normal file
213
lisp/erc/erc-lang.el
Normal file
|
|
@ -0,0 +1,213 @@
|
|||
;;; erc-lang.el --- provide the LANG command to ERC
|
||||
|
||||
;; Copyright (C) 2002, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Alex Schroeder <alex@gnu.org>
|
||||
;; Maintainer: Alex Schroeder <alex@gnu.org>
|
||||
;; Version: 1.0.0
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcLang
|
||||
;; Keywords: comm languages processes
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This provides two commands: `language' is for everyday use, and
|
||||
;; `erc-cmd-LANG' provides the /LANG command to ERC.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
|
||||
(defvar iso-638-languages
|
||||
'(("aa" . "Afar")
|
||||
("ab" . "Abkhazian")
|
||||
("af" . "Afrikaans")
|
||||
("am" . "Amharic")
|
||||
("ar" . "Arabic")
|
||||
("as" . "Assamese")
|
||||
("ay" . "Aymara")
|
||||
("az" . "Azerbaijani")
|
||||
("ba" . "Bashkir")
|
||||
("be" . "Byelorussian")
|
||||
("bg" . "Bulgarian")
|
||||
("bh" . "Bihari")
|
||||
("bi" . "Bislama")
|
||||
("bn" . "Bengali; Bangla")
|
||||
("bo" . "Tibetan")
|
||||
("br" . "Breton")
|
||||
("ca" . "Catalan")
|
||||
("co" . "Corsican")
|
||||
("cs" . "Czech")
|
||||
("cy" . "Welsh")
|
||||
("da" . "Danish")
|
||||
("de" . "German")
|
||||
("dz" . "Bhutani")
|
||||
("el" . "Greek")
|
||||
("en" . "English")
|
||||
("eo" . "Esperanto")
|
||||
("es" . "Spanish")
|
||||
("et" . "Estonian")
|
||||
("eu" . "Basque")
|
||||
("fa" . "Persian")
|
||||
("fi" . "Finnish")
|
||||
("fj" . "Fiji")
|
||||
("fo" . "Faroese")
|
||||
("fr" . "French")
|
||||
("fy" . "Frisian")
|
||||
("ga" . "Irish")
|
||||
("gd" . "Scots Gaelic")
|
||||
("gl" . "Galician")
|
||||
("gn" . "Guarani")
|
||||
("gu" . "Gujarati")
|
||||
("ha" . "Hausa")
|
||||
("he" . "Hebrew (formerly iw)")
|
||||
("hi" . "Hindi")
|
||||
("hr" . "Croatian")
|
||||
("hu" . "Hungarian")
|
||||
("hy" . "Armenian")
|
||||
("ia" . "Interlingua")
|
||||
("id" . "Indonesian (formerly in)")
|
||||
("ie" . "Interlingue")
|
||||
("ik" . "Inupiak")
|
||||
("is" . "Icelandic")
|
||||
("it" . "Italian")
|
||||
("iu" . "Inuktitut")
|
||||
("ja" . "Japanese")
|
||||
("jw" . "Javanese")
|
||||
("ka" . "Georgian")
|
||||
("kk" . "Kazakh")
|
||||
("kl" . "Greenlandic")
|
||||
("km" . "Cambodian")
|
||||
("kn" . "Kannada")
|
||||
("ko" . "Korean")
|
||||
("ks" . "Kashmiri")
|
||||
("ku" . "Kurdish")
|
||||
("ky" . "Kirghiz")
|
||||
("la" . "Latin")
|
||||
("ln" . "Lingala")
|
||||
("lo" . "Laothian")
|
||||
("lt" . "Lithuanian")
|
||||
("lv" . "Latvian, Lettish")
|
||||
("mg" . "Malagasy")
|
||||
("mi" . "Maori")
|
||||
("mk" . "Macedonian")
|
||||
("ml" . "Malayalam")
|
||||
("mn" . "Mongolian")
|
||||
("mo" . "Moldavian")
|
||||
("mr" . "Marathi")
|
||||
("ms" . "Malay")
|
||||
("mt" . "Maltese")
|
||||
("my" . "Burmese")
|
||||
("na" . "Nauru")
|
||||
("ne" . "Nepali")
|
||||
("nl" . "Dutch")
|
||||
("no" . "Norwegian")
|
||||
("oc" . "Occitan")
|
||||
("om" . "(Afan) Oromo")
|
||||
("or" . "Oriya")
|
||||
("pa" . "Punjabi")
|
||||
("pl" . "Polish")
|
||||
("ps" . "Pashto, Pushto")
|
||||
("pt" . "Portuguese")
|
||||
("qu" . "Quechua")
|
||||
("rm" . "Rhaeto-Romance")
|
||||
("rn" . "Kirundi")
|
||||
("ro" . "Romanian")
|
||||
("ru" . "Russian")
|
||||
("rw" . "Kinyarwanda")
|
||||
("sa" . "Sanskrit")
|
||||
("sd" . "Sindhi")
|
||||
("sg" . "Sangho")
|
||||
("sh" . "Serbo-Croatian")
|
||||
("si" . "Sinhalese")
|
||||
("sk" . "Slovak")
|
||||
("sl" . "Slovenian")
|
||||
("sm" . "Samoan")
|
||||
("sn" . "Shona")
|
||||
("so" . "Somali")
|
||||
("sq" . "Albanian")
|
||||
("sr" . "Serbian")
|
||||
("ss" . "Siswati")
|
||||
("st" . "Sesotho")
|
||||
("su" . "Sundanese")
|
||||
("sv" . "Swedish")
|
||||
("sw" . "Swahili")
|
||||
("ta" . "Tamil")
|
||||
("te" . "Telugu")
|
||||
("tg" . "Tajik")
|
||||
("th" . "Thai")
|
||||
("ti" . "Tigrinya")
|
||||
("tk" . "Turkmen")
|
||||
("tl" . "Tagalog")
|
||||
("tn" . "Setswana")
|
||||
("to" . "Tonga")
|
||||
("tr" . "Turkish")
|
||||
("ts" . "Tsonga")
|
||||
("tt" . "Tatar")
|
||||
("tw" . "Twi")
|
||||
("ug" . "Uighur")
|
||||
("uk" . "Ukrainian")
|
||||
("ur" . "Urdu")
|
||||
("uz" . "Uzbek")
|
||||
("vi" . "Vietnamese")
|
||||
("vo" . "Volapuk")
|
||||
("wo" . "Wolof")
|
||||
("xh" . "Xhosa")
|
||||
("yi" . "Yiddish (formerly ji)")
|
||||
("yo" . "Yoruba")
|
||||
("za" . "Zhuang")
|
||||
("zh" . "Chinese")
|
||||
("zu" . "Zulu"))
|
||||
"Alist of ISO language codes and language names.
|
||||
This is based on the technical contents of ISO 639:1988 (E/F)
|
||||
\"Code for the representation of names of languages\".
|
||||
|
||||
Typed by Keld.Simonsen@dkuug.dk 1990-11-30
|
||||
<ftp://dkuug.dk/i18n/ISO_639>
|
||||
Minor corrections, 1992-09-08 by Keld Simonsen
|
||||
Sundanese corrected, 1992-11-11 by Keld Simonsen
|
||||
Telugu corrected, 1995-08-24 by Keld Simonsen
|
||||
Hebrew, Indonesian, Yiddish corrected 1995-10-10 by Michael Everson
|
||||
Inuktitut, Uighur, Zhuang added 1995-10-10 by Michael Everson
|
||||
Sinhalese corrected, 1995-10-10 by Michael Everson
|
||||
Faeroese corrected to Faroese, 1995-11-18 by Keld Simonsen
|
||||
Sangro corrected to Sangho, 1996-07-28 by Keld Simonsen
|
||||
|
||||
Two-letter lower-case symbols are used.
|
||||
The Registration Authority for ISO 639 is Infoterm, Osterreichisches
|
||||
Normungsinstitut (ON), Postfach 130, A-1021 Vienna, Austria.")
|
||||
|
||||
(defun language (code)
|
||||
"Return the language name for the ISO CODE."
|
||||
(interactive (list (completing-read "ISO language code: "
|
||||
iso-638-languages)))
|
||||
(message (cdr (assoc code iso-638-languages))))
|
||||
|
||||
(defun erc-cmd-LANG (language)
|
||||
"Display the language name for the language code given by LANGUAGE."
|
||||
(let ((lang (cdr (assoc language iso-638-languages))))
|
||||
(erc-display-message
|
||||
nil 'notice 'active
|
||||
(or lang (concat line ": No such domain"))))
|
||||
t)
|
||||
|
||||
(provide 'erc-lang)
|
||||
|
||||
;; arch-tag: 8ffb1563-cc03-4517-b067-16309d4ff97b
|
||||
;;; erc-lang.el ends here
|
||||
396
lisp/erc/erc-list.el
Normal file
396
lisp/erc/erc-list.el
Normal file
|
|
@ -0,0 +1,396 @@
|
|||
;;; erc-list.el --- Provide a faster channel listing mechanism
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2004 Brian Palmer
|
||||
|
||||
;; Author: Mario Lang <mlang@lexx.delysid.org>
|
||||
;; Keywords: comm
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file provides a simple derived mode for viewing Channel lists.
|
||||
;; It also serves as a demonstration of how the new server hook facility
|
||||
;; can be used.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'erc-nets)
|
||||
(require 'sort)
|
||||
(unless (fboundp 'make-overlay)
|
||||
(require 'overlay))
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; User customizable variables.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgroup erc-list nil
|
||||
"Display IRC channels in another window when using /LIST"
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-chanlist-progress-message t
|
||||
"*Show progress message while accumulating channel list."
|
||||
:group 'erc-list
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-no-list-networks nil
|
||||
"*A list of network names on which the /LIST command refuses to work."
|
||||
:group 'erc-list
|
||||
:type '(repeat string))
|
||||
|
||||
(defcustom erc-chanlist-frame-parameters nil
|
||||
"*If nil, the channel list is displayed in a new window; if non-nil,
|
||||
this variable holds the frame parameters used to make a frame to
|
||||
display the channel list."
|
||||
:group 'erc-list
|
||||
:type 'list)
|
||||
|
||||
(defcustom erc-chanlist-hide-modeline nil
|
||||
"*If nil, the channel list buffer has a modeline, otherwise the modeline is hidden."
|
||||
:group 'erc-list
|
||||
:type 'boolean)
|
||||
|
||||
(defface erc-chanlist-header-face '((t (:bold t)))
|
||||
"Face used for the headers in erc's channel list."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface erc-chanlist-odd-line-face '((t (:inverse-video t)))
|
||||
"Face used for the odd lines in erc's channel list."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface erc-chanlist-even-line-face '((t (:inverse-video nil)))
|
||||
"Face used for the even lines in erc's channel list."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface erc-chanlist-highlight '((t (:foreground "red")))
|
||||
"Face used to highlight the current line in the channel list."
|
||||
:group 'erc-faces)
|
||||
|
||||
;; This should perhaps be a defface that inherits values from the highlight face
|
||||
;; but xemacs does not support inheritance
|
||||
(defcustom erc-chanlist-highlight-face 'erc-chanlist-highlight
|
||||
"Face used for highlighting the current line in a list."
|
||||
:type 'face
|
||||
:group 'erc-faces)
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; All variables below this line are for internal use only.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defvar erc-chanlist-channel-line-regexp "^\\([#&\\*][^ \t\n]*\\)\\s-+[0-9]+"
|
||||
"Regexp that matches a channel line in the channel list buffer.")
|
||||
|
||||
(defvar erc-chanlist-buffer nil)
|
||||
(make-variable-buffer-local 'erc-chanlist-buffer)
|
||||
|
||||
(defvar erc-chanlist-last-time 0
|
||||
"A time value used to throttle the progress indicator.")
|
||||
|
||||
(defvar erc-chanlist-frame nil
|
||||
"The frame displaying the most recent channel list buffer.")
|
||||
|
||||
(defvar erc-chanlist-sort-state 'channel
|
||||
"The sort mode of the channel list buffer. Either 'channel or 'users.")
|
||||
(make-variable-buffer-local 'erc-chanlist-sort-state)
|
||||
|
||||
(defvar erc-chanlist-highlight-overlay nil
|
||||
"The overlay used for erc chanlist highlighting")
|
||||
(make-variable-buffer-local 'erc-chanlist-highlight-overlay)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Define erc-chanlist-mode.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defcustom erc-chanlist-mode-hook nil
|
||||
"Hook run by erc-chanlist-mode."
|
||||
:group 'erc-list
|
||||
:type 'hook)
|
||||
|
||||
(define-derived-mode erc-chanlist-mode fundamental-mode "ERC Channel List"
|
||||
"Mode for viewing a channel list of a particular server.
|
||||
|
||||
\\{erc-chanlist-mode-map}"
|
||||
(local-set-key "\C-c\C-j" 'erc-join-channel)
|
||||
(local-set-key "j" 'erc-chanlist-join-channel)
|
||||
(local-set-key "n" 'next-line)
|
||||
(local-set-key "p" 'previous-line)
|
||||
(local-set-key "q" 'erc-chanlist-quit)
|
||||
(local-set-key "s" 'erc-chanlist-toggle-sort-state)
|
||||
(local-set-key "t" 'toggle-truncate-lines)
|
||||
(setq erc-chanlist-sort-state 'channel)
|
||||
(setq truncate-lines t)
|
||||
(add-hook 'post-command-hook 'erc-chanlist-post-command-hook 'append 'local))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Functions.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-cmd-LIST (&rest channel)
|
||||
"Display a buffer containing a list of channels on the current server.
|
||||
Optional argument CHANNEL specifies a single channel to list (instead of every
|
||||
available channel)."
|
||||
(interactive
|
||||
(remove "" (split-string
|
||||
(read-from-minibuffer "List channels (RET for all): ") " ")))
|
||||
(if (and (null channel)
|
||||
(erc-member-ignore-case (erc-network-name) erc-no-list-networks))
|
||||
(erc-display-line "ERC is configured not to allow the /LIST command on this network!"
|
||||
(current-buffer))
|
||||
(erc-display-line (erc-make-notice (concat "Listing channel"
|
||||
(if channel
|
||||
"."
|
||||
"s. This may take a while."))))
|
||||
(erc-chanlist channel))
|
||||
t)
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-chanlist (&optional channels)
|
||||
"Show a channel listing of the current server in a special mode.
|
||||
Please note that this function only works with IRC servers which conform
|
||||
to RFC and send the LIST header (#321) at start of list transmission."
|
||||
(interactive)
|
||||
(with-current-buffer (erc-server-buffer)
|
||||
(erc-once-with-server-event
|
||||
321
|
||||
'(progn
|
||||
(add-hook 'erc-server-322-functions 'erc-chanlist-322 nil t)
|
||||
|
||||
(erc-once-with-server-event
|
||||
323
|
||||
'(progn
|
||||
(remove-hook 'erc-server-322-functions 'erc-chanlist-322 t)
|
||||
(let ((buf erc-chanlist-buffer))
|
||||
(if (not (buffer-live-p buf))
|
||||
(error "`erc-chanlist-buffer' does not refer to a live buffer"))
|
||||
|
||||
(set-buffer buf)
|
||||
(buffer-disable-undo)
|
||||
(let (buffer-read-only
|
||||
(sort-fold-case t))
|
||||
(sort-lines nil (point-min) (point-max))
|
||||
(setq erc-chanlist-sort-state 'channel)
|
||||
|
||||
(let ((sum (count-lines (point-min) (point-max))))
|
||||
(goto-char (point-min))
|
||||
(insert (substitute-command-keys
|
||||
(concat "'\\[erc-chanlist-toggle-sort-state]' toggle sort mode.\n"
|
||||
"'\\[erc-chanlist-quit]' kill this buffer.\n"
|
||||
"'\\[toggle-truncate-lines]' toggle line truncation.\n"
|
||||
"'\\[erc-chanlist-join-channel]' join the channel listed on the current line.\n\n")))
|
||||
(insert (format "%d channels (sorted by %s).\n\n"
|
||||
sum (if (eq erc-chanlist-sort-state 'channel)
|
||||
"channel name"
|
||||
"number of users"))))
|
||||
|
||||
(insert (format "%-25s%5s %s\n------------------------ ----- ----------------------------\n"
|
||||
"Channel"
|
||||
"Users"
|
||||
"Topic"))
|
||||
|
||||
;; Display the channel list buffer.
|
||||
(if erc-chanlist-frame-parameters
|
||||
(progn
|
||||
(if (or (null erc-chanlist-frame)
|
||||
(not (frame-live-p erc-chanlist-frame)))
|
||||
(setq erc-chanlist-frame
|
||||
(make-frame `((name . ,(format "Channels on %s"
|
||||
erc-session-server))
|
||||
,@erc-chanlist-frame-parameters))))
|
||||
(select-frame erc-chanlist-frame)
|
||||
(switch-to-buffer buf)
|
||||
(erc-prettify-channel-list))
|
||||
(pop-to-buffer buf)
|
||||
(erc-prettify-channel-list))))
|
||||
(goto-char (point-min))
|
||||
(search-forward-regexp "^------" nil t)
|
||||
(forward-line 1)
|
||||
(erc-chanlist-highlight-line)
|
||||
(message "")
|
||||
t))
|
||||
|
||||
(setq erc-chanlist-buffer (get-buffer-create
|
||||
(format "*Channels on %s*"
|
||||
(erc-response.sender parsed))))
|
||||
(with-current-buffer erc-chanlist-buffer
|
||||
(setq buffer-read-only nil)
|
||||
(erase-buffer)
|
||||
(erc-chanlist-mode)
|
||||
(setq erc-server-process proc)
|
||||
(if erc-chanlist-hide-modeline
|
||||
(setq mode-line-format nil))
|
||||
(setq buffer-read-only t))
|
||||
t))
|
||||
|
||||
;; Now that we've setup our callbacks, pull the trigger.
|
||||
(if (interactive-p)
|
||||
(message "Collecting channel list for server %s" erc-session-server))
|
||||
(erc-server-send (if (null channels)
|
||||
"LIST"
|
||||
(concat "LIST "
|
||||
(mapconcat #'identity channels ","))))))
|
||||
|
||||
(defun erc-chanlist-322 (proc parsed)
|
||||
"Process an IRC 322 message.
|
||||
|
||||
The message carries information about one channel for the LIST
|
||||
command."
|
||||
(multiple-value-bind (channel num-users)
|
||||
(cdr (erc-response.command-args parsed))
|
||||
(let ((topic (erc-response.contents parsed)))
|
||||
(with-current-buffer erc-chanlist-buffer
|
||||
(save-excursion
|
||||
(goto-char (point-max))
|
||||
(let (buffer-read-only)
|
||||
(insert (format "%-26s%4s %s\n" (erc-controls-strip channel)
|
||||
num-users
|
||||
(erc-controls-strip topic))))
|
||||
|
||||
;; Maybe display a progress indicator in the minibuffer.
|
||||
(when (and erc-chanlist-progress-message
|
||||
(> (erc-time-diff
|
||||
erc-chanlist-last-time (erc-current-time))
|
||||
3))
|
||||
(setq erc-chanlist-last-time (erc-current-time))
|
||||
(message "Accumulating channel list ... %c"
|
||||
(aref [?/ ?| ?\\ ?- ?! ?O ?o] (random 7))))
|
||||
|
||||
;; Return success to prevent other hook functions from being run.
|
||||
t)))))
|
||||
|
||||
(defun erc-chanlist-post-command-hook ()
|
||||
"Keep the current line highlighted."
|
||||
(ignore-errors
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (looking-at erc-chanlist-channel-line-regexp)
|
||||
(erc-chanlist-highlight-line)
|
||||
(erc-chanlist-dehighlight-line)))))
|
||||
|
||||
(defun erc-chanlist-highlight-line ()
|
||||
"Highlight the current line."
|
||||
(unless erc-chanlist-highlight-overlay
|
||||
(setq erc-chanlist-highlight-overlay
|
||||
(make-overlay (point-min) (point-min)))
|
||||
;; Detach it from the buffer.
|
||||
(delete-overlay erc-chanlist-highlight-overlay)
|
||||
(overlay-put erc-chanlist-highlight-overlay
|
||||
'face erc-chanlist-highlight-face)
|
||||
;; Expressly put it at a higher priority than the text
|
||||
;; properties used for faces later on. Gnu emacs promises that
|
||||
;; right now overlays are higher priority than text properties,
|
||||
;; but why take chances?
|
||||
(overlay-put erc-chanlist-highlight-overlay 'priority 1))
|
||||
(move-overlay erc-chanlist-highlight-overlay (point) (1+ (point-at-eol))))
|
||||
|
||||
(defun erc-chanlist-dehighlight-line ()
|
||||
"Remove the line highlighting."
|
||||
(delete-overlay erc-chanlist-highlight-overlay))
|
||||
|
||||
(defun erc-prettify-channel-list ()
|
||||
"Make the channel list buffer look pretty.
|
||||
When this function runs, the current buffer must be the channel
|
||||
list buffer, or it does nothing."
|
||||
(if (eq major-mode 'erc-chanlist-mode)
|
||||
(save-excursion
|
||||
(let ((inhibit-read-only t))
|
||||
(goto-char (point-min))
|
||||
(when (search-forward-regexp "^-------" nil t)
|
||||
(add-text-properties
|
||||
(point-min) (1+ (point-at-eol)) '(face erc-chanlist-header-face))
|
||||
(forward-line 1))
|
||||
|
||||
(while (not (eobp))
|
||||
(add-text-properties
|
||||
(point) (1+ (point-at-eol)) '(face erc-chanlist-odd-line-face))
|
||||
(forward-line 1)
|
||||
(unless (eobp)
|
||||
(add-text-properties
|
||||
(point) (1+ (point-at-eol)) '(face erc-chanlist-even-line-face)))
|
||||
(forward-line 1))))))
|
||||
|
||||
(defun erc-chanlist-toggle-sort-state ()
|
||||
"Toggle the channel list buffer sorting method.
|
||||
Either sort by channel names or by number of users in each channel."
|
||||
(interactive)
|
||||
(let ((inhibit-read-only t)
|
||||
(sort-fold-case t))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(search-forward-regexp "^-----" nil t)
|
||||
(forward-line 1)
|
||||
(unless (eobp)
|
||||
(if (eq erc-chanlist-sort-state 'channel)
|
||||
(progn
|
||||
(sort-numeric-fields 2 (point) (point-max))
|
||||
(reverse-region (point) (point-max))
|
||||
(setq erc-chanlist-sort-state 'users))
|
||||
(sort-lines nil (point) (point-max))
|
||||
(setq erc-chanlist-sort-state 'channel))
|
||||
|
||||
(goto-char (point-min))
|
||||
(if (search-forward-regexp "^[0-9]+ channels (sorted by \\(.*\\)).$"
|
||||
nil t)
|
||||
(replace-match (if (eq erc-chanlist-sort-state 'channel)
|
||||
"channel name"
|
||||
"number of users")
|
||||
nil nil nil 1))
|
||||
|
||||
(goto-char (point-min))
|
||||
(search-forward-regexp "^-----" nil t)
|
||||
(forward-line 1)
|
||||
(recenter -1)
|
||||
|
||||
(erc-prettify-channel-list)))))
|
||||
|
||||
(defun erc-chanlist-quit ()
|
||||
"Quit Chanlist mode.
|
||||
Kill the channel list buffer, window, and frame (if there's a frame
|
||||
devoted to the channel list)."
|
||||
(interactive)
|
||||
(kill-buffer (current-buffer))
|
||||
(if (eq (selected-frame) erc-chanlist-frame)
|
||||
(delete-frame)
|
||||
(delete-window)))
|
||||
|
||||
(defun erc-chanlist-join-channel ()
|
||||
"Join the channel listed on the current line of the channel list buffer.
|
||||
Private channels, which are shown as asterisks (*), are ignored."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (looking-at erc-chanlist-channel-line-regexp)
|
||||
(let ((channel-name (match-string 1)))
|
||||
(when (and (stringp channel-name)
|
||||
(not (string= channel-name "*")))
|
||||
(run-at-time 0.5 nil 'erc-join-channel channel-name))))))
|
||||
|
||||
(provide 'erc-list)
|
||||
|
||||
;;; erc-list.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 4a13196a-a61b-465a-9926-044dfbc7e5ff
|
||||
358
lisp/erc/erc-log.el
Normal file
358
lisp/erc/erc-log.el
Normal file
|
|
@ -0,0 +1,358 @@
|
|||
;;; erc-log.el --- Logging facilities for ERC.
|
||||
|
||||
;; Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Lawrence Mitchell <wence@gmx.li>
|
||||
;; Keywords: IRC, chat, client, Internet, logging
|
||||
|
||||
;; Created 2003-04-26
|
||||
;; Logging code taken from erc.el and modified to use markers.
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file implements log file writing support for ERC.
|
||||
|
||||
;; Quick start:
|
||||
;;
|
||||
;; (setq erc-enable-logging t)
|
||||
;; (setq erc-log-channels-directory "/path/to/logfiles") ; must be writable
|
||||
;;
|
||||
;; There are two ways to setup logging. The first will write to the log files
|
||||
;; on each incoming or outgoing line - this may not be optimal on a laptop
|
||||
;; HDD. To do this, M-x customize-variable erc-modules, and add "log".
|
||||
;;
|
||||
;; The second method will save buffers on /part, /quit, or killing the
|
||||
;; channel buffer. To do this, add the following to your .emacs:
|
||||
;;
|
||||
;; (require 'erc-log)
|
||||
;;
|
||||
;; You may optionally want the following code, to save all ERC buffers
|
||||
;; without confirmation when exiting emacs:
|
||||
;;
|
||||
;; (defadvice save-buffers-kill-emacs (before save-logs (&rest args) activate)
|
||||
;; (save-some-buffers t (lambda ()
|
||||
;; (when (and (eq major-mode 'erc-mode)
|
||||
;; (not (null buffer-file-name))) t))))
|
||||
;;
|
||||
;; If you only want to save logs for some buffers, customise the
|
||||
;; variable `erc-enable-logging'.
|
||||
|
||||
;; How it works:
|
||||
;;
|
||||
;; If logging is enabled, at some point, `erc-save-buffer-in-logs'
|
||||
;; will be called. The "end" of the buffer is taken from
|
||||
;; `erc-insert-marker', while `erc-last-saved-position' holds the
|
||||
;; position the buffer was last saved at (as a marker, or if the
|
||||
;; buffer hasn't been saved before, as the number 1 (point-min)).
|
||||
|
||||
;; The region between `erc-last-saved-position' and
|
||||
;; `erc-insert-marker' is saved to the current buffer's logfile, and
|
||||
;; `erc-last-saved-position' is updated to reflect this.
|
||||
|
||||
;;; History:
|
||||
;; 2003-04-26: logging code pulled out of erc.el. Switched to using
|
||||
;; markers.
|
||||
|
||||
;;; TODO:
|
||||
;; * Erc needs a generalised make-safe-file-name function, so that
|
||||
;; generated file names don't contain any invalid file characters.
|
||||
;;
|
||||
;; * Really, we need to lock the logfiles somehow, so that if a user
|
||||
;; is running multiple emacsen and/or on the same channel as more
|
||||
;; than one user, only one process writes to the logfile. This is
|
||||
;; especially needed for those logfiles with no nick in them, as
|
||||
;; these would become corrupted.
|
||||
;; For a single emacs process, the problem could be solved using a
|
||||
;; variable which contained the names of buffers already being
|
||||
;; logged. This would require that logging be buffer-local,
|
||||
;; possibly not a bad thing anyway, since many people don't want to
|
||||
;; log the server buffer.
|
||||
;; For multiple emacsen the problem is trickier. On some systems,
|
||||
;; on could use the function `lock-buffer' and `unlock-buffer'.
|
||||
;; However, file locking isn't implemented on all platforms, for
|
||||
;; example, there is none on w32 systems.
|
||||
;; A third possibility might be to fake lockfiles. However, this
|
||||
;; might lead to problems if an emacs crashes, as the lockfile
|
||||
;; would be left lying around.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup erc-log nil
|
||||
"Logging facilities for ERC."
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-generate-log-file-name-function 'erc-generate-log-file-name-long
|
||||
"*A function to generate a log filename.
|
||||
The function must take five arguments: BUFFER, TARGET, NICK, SERVER and PORT.
|
||||
BUFFER is the buffer to be saved,
|
||||
TARGET is the name of the channel, or the target of the query,
|
||||
NICK is the current nick,
|
||||
SERVER and PORT are the parameters used to connect BUFFERs
|
||||
`erc-server-process'."
|
||||
:group 'erc-log
|
||||
:type '(choice (const erc-generate-log-file-name-long)
|
||||
(const erc-generate-log-file-name-short)
|
||||
(const erc-generate-log-file-name-with-date)
|
||||
(symbol)))
|
||||
|
||||
(defcustom erc-save-buffer-on-part nil
|
||||
"*Save the channel buffer content using `erc-save-buffer-in-logs' on PART."
|
||||
:group 'erc-log
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-truncate-buffer-on-save nil
|
||||
"Truncate any ERC (channel, query, server) buffer when it is saved."
|
||||
:group 'erc-log
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-enable-logging t
|
||||
"If non-nil, ERC will log IRC conversations.
|
||||
This can either be a boolean value of nil or t, or a function.
|
||||
If the value is a function, it will be called with one argument, the
|
||||
name of the current ERC buffer. One possible function, which saves
|
||||
all but server buffers is `erc-log-all-but-server-buffers'.
|
||||
|
||||
This variable is buffer local. Setting it via \\[customize] sets the
|
||||
default value.
|
||||
|
||||
Log files are stored in `erc-log-channels-directory'."
|
||||
:group 'erc-log
|
||||
:type '(choice boolean
|
||||
function))
|
||||
(make-variable-buffer-local 'erc-enable-logging)
|
||||
|
||||
(defcustom erc-log-channels-directory "~/log"
|
||||
"The directory to place log files for channels.
|
||||
Leave blank to disable logging. If not nil, all the channel
|
||||
buffers are logged in separate files in that directory. The
|
||||
directory should not end with a trailing slash."
|
||||
:group 'erc-log
|
||||
:type '(choice directory
|
||||
(const nil)))
|
||||
|
||||
(defcustom erc-log-insert-log-on-open t
|
||||
"*Insert log file contents into the buffer if a log file exists."
|
||||
:group 'erc-log
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-save-queries-on-quit nil
|
||||
"Save all query (also channel) buffers of the server on QUIT.
|
||||
See the variable `erc-save-buffer-on-part' for details."
|
||||
:group 'erc-log
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-log-file-coding-system (if (featurep 'xemacs)
|
||||
'binary
|
||||
'emacs-mule)
|
||||
"*The coding system ERC should use for writing log files.
|
||||
|
||||
This should ideally, be a \"catch-all\" coding system, like
|
||||
`emacs-mule', or `iso-2022-7bit'."
|
||||
:group 'erc-log)
|
||||
|
||||
;;;###autoload (autoload 'erc-log-mode "erc-log" nil t)
|
||||
(define-erc-module log nil
|
||||
"Automatically logs things you receive on IRC into files.
|
||||
Files are stored in `erc-log-channels-directory'; file name
|
||||
format is defined through a formatting function on
|
||||
`erc-generate-log-file-name-function'.
|
||||
|
||||
Since automatic logging is not always a Good Thing (especially if
|
||||
people say things in different coding systems), you can turn logging
|
||||
behaviour on and off with the variable `erc-enable-logging', which can
|
||||
also be a predicate function. To only log when you are not set away, use:
|
||||
|
||||
\(setq erc-enable-logging
|
||||
(lambda (buffer)
|
||||
(with-current-buffer buffer
|
||||
(not erc-away))))"
|
||||
;; enable
|
||||
((add-hook 'erc-insert-post-hook
|
||||
'erc-save-buffer-in-logs)
|
||||
(add-hook 'erc-send-post-hook
|
||||
'erc-save-buffer-in-logs))
|
||||
;; disable
|
||||
((remove-hook 'erc-insert-post-hook
|
||||
'erc-save-buffer-in-logs)
|
||||
(remove-hook 'erc-send-post-hook
|
||||
'erc-save-buffer-in-logs)))
|
||||
|
||||
(when erc-enable-logging
|
||||
(add-hook 'erc-kill-buffer-hook
|
||||
'erc-save-buffer-in-logs)
|
||||
(add-hook 'erc-kill-channel-hook
|
||||
'erc-save-buffer-in-logs)
|
||||
(add-hook 'erc-quit-hook
|
||||
'erc-conditional-save-queries)
|
||||
(add-hook 'erc-part-hook
|
||||
'erc-conditional-save-buffer))
|
||||
|
||||
(define-key erc-mode-map "\C-c\C-l" 'erc-save-buffer-in-logs)
|
||||
|
||||
;;;functionality referenced from erc.el
|
||||
(defun erc-log-setup-logging ()
|
||||
"Setup the buffer-local logging variables in the current buffer.
|
||||
This function is destined to be run from `erc-connect-pre-hook'."
|
||||
(when (erc-logging-enabled)
|
||||
(auto-save-mode -1)
|
||||
(setq buffer-offer-save t
|
||||
buffer-file-name "")
|
||||
(set (make-local-variable 'write-file-functions)
|
||||
'(erc-save-buffer-in-logs))
|
||||
(when erc-log-insert-log-on-open
|
||||
(ignore-errors (insert-file-contents (erc-current-logfile))
|
||||
(move-marker erc-last-saved-position
|
||||
(1- (point-max)))))))
|
||||
|
||||
;;; Append, so that 'erc-initialize-log-marker keeps running first.
|
||||
(add-hook 'erc-connect-pre-hook 'erc-log-setup-logging 'append)
|
||||
|
||||
(defun erc-log-all-but-server-buffers (buffer)
|
||||
"Returns t if logging should be enabled in BUFFER.
|
||||
Returns nil iff `erc-server-buffer-p' returns t."
|
||||
(save-excursion
|
||||
(save-window-excursion
|
||||
(set-buffer buffer)
|
||||
(not (erc-server-buffer-p)))))
|
||||
|
||||
(defun erc-save-query-buffers (process)
|
||||
"Save all buffers process."
|
||||
(erc-with-all-buffers-of-server process
|
||||
nil
|
||||
(erc-save-buffer-in-logs)))
|
||||
|
||||
(defun erc-conditional-save-buffer (buffer)
|
||||
"Save Query BUFFER if `erc-save-queries-on-quit' is t."
|
||||
(when erc-save-buffer-on-part
|
||||
(erc-save-buffer-in-logs buffer)))
|
||||
|
||||
(defun erc-conditional-save-queries (process)
|
||||
"Save Query buffers of PROCESS if `erc-save-queries-on-quit' is t."
|
||||
(when erc-save-queries-on-quit
|
||||
(erc-save-query-buffers process)))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-logging-enabled (&optional buffer)
|
||||
"Return non-nil if logging is enabled for BUFFER.
|
||||
If BUFFER is nil, the value of `current-buffer' is used.
|
||||
Logging is enabled if `erc-log-channels-directory' is non-nil, the directory
|
||||
is writeable (it will be created as necessary) and
|
||||
`erc-enable-logging' returns a non-nil value."
|
||||
(and erc-log-channels-directory
|
||||
(erc-directory-writable-p erc-log-channels-directory)
|
||||
(if (functionp erc-enable-logging)
|
||||
(funcall erc-enable-logging (or buffer (current-buffer)))
|
||||
erc-enable-logging)))
|
||||
|
||||
(defun erc-current-logfile (&optional buffer)
|
||||
"Return the logfile to use for BUFFER.
|
||||
If BUFFER is nil, the value of `current-buffer' is used.
|
||||
This is determined by `erc-generate-log-file-name-function'.
|
||||
The result is converted to lowercase, as IRC is case-insensitive"
|
||||
(expand-file-name
|
||||
(downcase (funcall erc-generate-log-file-name-function
|
||||
(or buffer (current-buffer))
|
||||
(or (erc-default-target) (buffer-name buffer))
|
||||
(erc-current-nick)
|
||||
erc-session-server erc-session-port))
|
||||
erc-log-channels-directory))
|
||||
|
||||
(defun erc-generate-log-file-name-with-date (buffer &rest ignore)
|
||||
"This function computes a short log file name.
|
||||
The name of the log file is composed of BUFFER and the current date.
|
||||
This function is a possible value for `erc-generate-log-file-name-function'."
|
||||
(concat (buffer-name buffer) "-" (format-time-string "%Y-%m-%d") ".txt"))
|
||||
|
||||
(defun erc-generate-log-file-name-short (buffer &rest ignore)
|
||||
"This function computes a short log file name.
|
||||
In fact, it only uses the buffer name of the BUFFER argument, so
|
||||
you can affect that using `rename-buffer' and the-like. This
|
||||
function is a possible value for
|
||||
`erc-generate-log-file-name-function'."
|
||||
(concat (buffer-name buffer) ".txt"))
|
||||
|
||||
(defun erc-generate-log-file-name-long (buffer target nick server port)
|
||||
"Generates a log-file name in the way ERC always did it.
|
||||
This results in a file name of the form #channel!nick@server:port.txt.
|
||||
This function is a possible value for `erc-generate-log-file-name-function'."
|
||||
(let ((file (concat
|
||||
(if target (concat target "!"))
|
||||
nick "@" server ":" (cond ((stringp port) port)
|
||||
((numberp port)
|
||||
(number-to-string port))) ".txt")))
|
||||
;; we need a make-safe-file-name function.
|
||||
(convert-standard-filename file)))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-save-buffer-in-logs (&optional buffer)
|
||||
"Append BUFFER contents to the log file, if logging is enabled.
|
||||
If BUFFER is not provided, current buffer is used.
|
||||
Logging is enabled if `erc-logging-enabled' returns non-nil.
|
||||
|
||||
This is normally done on exit, to save the unsaved portion of the
|
||||
buffer, since only the text that runs off the buffer limit is logged
|
||||
automatically.
|
||||
|
||||
You can save every individual message by putting this function on
|
||||
`erc-insert-post-hook'."
|
||||
(interactive)
|
||||
(or buffer (setq buffer (current-buffer)))
|
||||
(when (erc-logging-enabled buffer)
|
||||
(let ((file (erc-current-logfile buffer))
|
||||
(coding-system-for-write erc-log-file-coding-system))
|
||||
(save-excursion
|
||||
(with-current-buffer buffer
|
||||
(save-restriction
|
||||
(widen)
|
||||
;; early on in the initalisation, don't try and write the log out
|
||||
(when (and (markerp erc-last-saved-position)
|
||||
(> erc-insert-marker (1+ erc-last-saved-position)))
|
||||
(write-region (1+ (marker-position erc-last-saved-position))
|
||||
(marker-position erc-insert-marker)
|
||||
file t 'nomessage)
|
||||
(if (and erc-truncate-buffer-on-save (interactive-p))
|
||||
(progn
|
||||
(let ((inhibit-read-only t)) (erase-buffer))
|
||||
(move-marker erc-last-saved-position (point-max))
|
||||
(erc-display-prompt))
|
||||
(move-marker erc-last-saved-position
|
||||
;; If we place erc-last-saved-position at
|
||||
;; erc-insert-marker, because text gets
|
||||
;; inserted /before/ erc-insert-marker,
|
||||
;; the log file will not be saved
|
||||
;; (erc-last-saved-position will always
|
||||
;; be equal to erc-insert-marker).
|
||||
(1- (marker-position erc-insert-marker)))))
|
||||
(set-buffer-modified-p nil))))))
|
||||
t)
|
||||
|
||||
(provide 'erc-log)
|
||||
|
||||
;;; erc-log.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 54072f99-9f0a-4846-8908-2ccde92221de
|
||||
658
lisp/erc/erc-match.el
Normal file
658
lisp/erc/erc-match.el
Normal file
|
|
@ -0,0 +1,658 @@
|
|||
;;; erc-match.el --- Highlight messages matching certain regexps
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Andreas Fuchs <asf@void.at>
|
||||
;; Keywords: comm, faces
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcMatch
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file includes stuff to work with pattern matching in ERC. If
|
||||
;; you were used to customizing erc-fools, erc-keywords, erc-pals,
|
||||
;; erc-dangerous-hosts and the like, this file contains these
|
||||
;; customizable variables.
|
||||
|
||||
;; Usage:
|
||||
;; Put (erc-match-mode 1) into your ~/.emacs file.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;; Customisation:
|
||||
|
||||
(defgroup erc-match nil
|
||||
"Keyword and Friend/Foe/... recognition.
|
||||
Group containing all things concerning pattern matching in ERC
|
||||
messages."
|
||||
:group 'erc)
|
||||
|
||||
;;;###autoload (autoload 'erc-match-mode "erc-match")
|
||||
(define-erc-module match nil
|
||||
"This mode checks whether messages match certain patterns. If so,
|
||||
they are hidden or highlighted. This is controlled via the variables
|
||||
`erc-pals', `erc-fools', `erc-keywords', `erc-dangerous-hosts', and
|
||||
`erc-current-nick-highlight-type'. For all these highlighting types,
|
||||
you can decide whether the entire message or only the sending nick is
|
||||
highlighted."
|
||||
((add-hook 'erc-insert-modify-hook 'erc-match-message 'append))
|
||||
((remove-hook 'erc-insert-modify-hook 'erc-match-message)))
|
||||
|
||||
;; Remaining customizations
|
||||
|
||||
(defcustom erc-pals nil
|
||||
"List of pals on IRC."
|
||||
:group 'erc-match
|
||||
:type '(repeat regexp))
|
||||
|
||||
(defcustom erc-fools nil
|
||||
"List of fools on IRC."
|
||||
:group 'erc-match
|
||||
:type '(repeat regexp))
|
||||
|
||||
(defcustom erc-keywords nil
|
||||
"List of keywords to highlight in all incoming messages.
|
||||
Each entry in the list is either a regexp, or a cons cell with the
|
||||
regexp in the car and the face to use in the cdr. If no face is
|
||||
specified, `erc-keyword-face' is used."
|
||||
:group 'erc-match
|
||||
:type '(repeat (choice regexp
|
||||
(list regexp face))))
|
||||
|
||||
(defcustom erc-dangerous-hosts nil
|
||||
"List of regexps for hosts to highlight.
|
||||
Useful to mark nicks from dangerous hosts."
|
||||
:group 'erc-match
|
||||
:type '(repeat regexp))
|
||||
|
||||
(defcustom erc-current-nick-highlight-type 'keyword
|
||||
"*Determines how to highlight text in which your current nickname appears
|
||||
\(does not apply to text sent by you\).
|
||||
|
||||
The following values are allowed:
|
||||
|
||||
nil - do not highlight the message at all
|
||||
'keyword - highlight all instances of current nickname in message
|
||||
'nick - highlight the nick of the user who typed your nickname
|
||||
'nick-or-keyword - highlight the nick of the user who typed your nickname,
|
||||
or all instances of the current nickname if there was
|
||||
no sending user
|
||||
'all - highlight the entire message where current nickname occurs
|
||||
|
||||
Any other value disables highlighting of current nickname altogether."
|
||||
:group 'erc-match
|
||||
:type '(choice (const nil)
|
||||
(const nick)
|
||||
(const keyword)
|
||||
(const nick-or-keyword)
|
||||
(const all)))
|
||||
|
||||
(defcustom erc-pal-highlight-type 'nick
|
||||
"*Determines how to highlight messages by pals.
|
||||
See `erc-pals'.
|
||||
|
||||
The following values are allowed:
|
||||
|
||||
nil - do not highlight the message at all
|
||||
'nick - highlight pal's nickname only
|
||||
'all - highlight the entire message from pal
|
||||
|
||||
Any other value disables pal highlighting altogether."
|
||||
:group 'erc-match
|
||||
:type '(choice (const nil)
|
||||
(const nick)
|
||||
(const all)))
|
||||
|
||||
(defcustom erc-fool-highlight-type 'nick
|
||||
"*Determines how to highlight messages by fools.
|
||||
See `erc-fools'.
|
||||
|
||||
The following values are allowed:
|
||||
|
||||
nil - do not highlight the message at all
|
||||
'nick - highlight fool's nickname only
|
||||
'all - highlight the entire message from fool
|
||||
|
||||
Any other value disables fool highlighting altogether."
|
||||
:group 'erc-match
|
||||
:type '(choice (const nil)
|
||||
(const nick)
|
||||
(const all)))
|
||||
|
||||
(defcustom erc-keyword-highlight-type 'keyword
|
||||
"*Determines how to highlight messages containing keywords.
|
||||
See variable `erc-keywords'.
|
||||
|
||||
The following values are allowed:
|
||||
|
||||
'keyword - highlight keyword only
|
||||
'all - highlight the entire message containing keyword
|
||||
|
||||
Any other value disables keyword highlighting altogether."
|
||||
:group 'erc-match
|
||||
:type '(choice (const nil)
|
||||
(const keyword)
|
||||
(const all)))
|
||||
|
||||
(defcustom erc-dangerous-host-highlight-type 'nick
|
||||
"*Determines how to highlight messages by nicks from dangerous-hosts.
|
||||
See `erc-dangerous-hosts'.
|
||||
|
||||
The following values are allowed:
|
||||
|
||||
'nick - highlight nick from dangerous-host only
|
||||
'all - highlight the entire message from dangerous-host
|
||||
|
||||
Any other value disables dangerous-host highlighting altogether."
|
||||
:group 'erc-match
|
||||
:type '(choice (const nil)
|
||||
(const nick)
|
||||
(const all)))
|
||||
|
||||
|
||||
(defcustom erc-log-matches-types-alist '((keyword . "ERC Keywords"))
|
||||
"Alist telling ERC where to log which match types.
|
||||
Valid match type keys are:
|
||||
- keyword
|
||||
- pal
|
||||
- dangerous-host
|
||||
- fool
|
||||
- current-nick
|
||||
|
||||
The other element of each cons pair in this list is the buffer name to
|
||||
use for the logged message."
|
||||
:group 'erc-match
|
||||
:type '(repeat (cons (choice :tag "Key"
|
||||
(const keyword)
|
||||
(const pal)
|
||||
(const dangerous-host)
|
||||
(const fool)
|
||||
(const current-nick))
|
||||
(string :tag "Buffer name"))))
|
||||
|
||||
(defcustom erc-log-matches-flag 'away
|
||||
"Flag specifying when matched message logging should happen.
|
||||
When nil, don't log any matched messages.
|
||||
When t, log messages.
|
||||
When 'away, log messages only when away."
|
||||
:group 'erc-match
|
||||
:type '(choice (const nil)
|
||||
(const away)
|
||||
(const t)))
|
||||
|
||||
(defcustom erc-log-match-format "%t<%n:%c> %m"
|
||||
"Format for matched Messages.
|
||||
This variable specifies how messages in the corresponding log buffers will
|
||||
be formatted. The various format specs are:
|
||||
|
||||
%t Timestamp (uses `erc-timestamp-format' if non-nil or \"[%Y-%m-%d %H:%M] \")
|
||||
%n Nickname of sender
|
||||
%u Nickname!user@host of sender
|
||||
%c Channel in which this was received
|
||||
%m Message"
|
||||
:group 'erc-match
|
||||
:type 'string)
|
||||
|
||||
(defcustom erc-beep-match-types '(current-nick)
|
||||
"Types of matches to beep for when a match occurs.
|
||||
The function `erc-beep-on-match' needs to be added to `erc-text-matched-hook'
|
||||
for beeping to work."
|
||||
:group 'erc-match
|
||||
:type '(choice (repeat :tag "Beep on match" (choice
|
||||
(const current-nick)
|
||||
(const keyword)
|
||||
(const pal)
|
||||
(const dangerous-host)
|
||||
(const fool)))
|
||||
(const :tag "Don't beep" nil)))
|
||||
|
||||
(defcustom erc-text-matched-hook '(erc-log-matches)
|
||||
"Hook run when text matches a given match-type.
|
||||
Functions in this hook are passed as arguments:
|
||||
\(match-type nick!user@host message) where MATCH-TYPE is a symbol of:
|
||||
current-nick, keyword, pal, dangerous-host, fool"
|
||||
:options '(erc-log-matches erc-hide-fools erc-beep-on-match)
|
||||
:group 'erc-match
|
||||
:type 'hook)
|
||||
|
||||
;; Internal variables:
|
||||
|
||||
;; This is exactly the same as erc-button-syntax-table. Should we
|
||||
;; just put it in erc.el
|
||||
(defvar erc-match-syntax-table
|
||||
(let ((table (make-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)
|
||||
(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)
|
||||
(modify-syntax-entry ?\\ "w" table)
|
||||
table)
|
||||
"Syntax table used when highlighting messages.
|
||||
This syntax table should make all the legal nick characters word
|
||||
constituents.")
|
||||
|
||||
;; Faces:
|
||||
|
||||
(defface erc-current-nick-face '((t (:bold t :foreground "DarkTurquoise")))
|
||||
"ERC face for occurrences of your current nickname."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface erc-dangerous-host-face '((t (:foreground "red")))
|
||||
"ERC face for people on dangerous hosts.
|
||||
See `erc-dangerous-hosts'."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface erc-pal-face '((t (:bold t :foreground "Magenta")))
|
||||
"ERC face for your pals.
|
||||
See `erc-pals'."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface erc-fool-face '((t (:foreground "dim gray")))
|
||||
"ERC face for fools on the channel.
|
||||
See `erc-fools'."
|
||||
:group 'erc-faces)
|
||||
|
||||
(defface erc-keyword-face '((t (:bold t :foreground "pale green")))
|
||||
"ERC face for your keywords.
|
||||
Note that this is the default face to use if
|
||||
`erc-keywords' does not specify another."
|
||||
:group 'erc-faces)
|
||||
|
||||
;; Functions:
|
||||
|
||||
(defun erc-add-entry-to-list (list prompt &optional completions)
|
||||
"Add an entry interactively to a list.
|
||||
LIST must be passed as a symbol
|
||||
The query happens using PROMPT.
|
||||
Completion is performed on the optional alist COMPLETIONS."
|
||||
(let ((entry (completing-read
|
||||
prompt
|
||||
completions
|
||||
(lambda (x)
|
||||
(not (erc-member-ignore-case (car x) (symbol-value list)))))))
|
||||
(if (erc-member-ignore-case entry (symbol-value list))
|
||||
(error (format "\"%s\" is already on the list" entry))
|
||||
(set list (cons entry (symbol-value list))))))
|
||||
|
||||
(defun erc-remove-entry-from-list (list prompt)
|
||||
"Remove an entry interactively from a list.
|
||||
LIST must be passed as a symbol.
|
||||
The elements of LIST can be strings, or cons cells where the
|
||||
car is the string."
|
||||
(let* ((alist (mapcar (lambda (x)
|
||||
(if (listp x)
|
||||
x
|
||||
(list x)))
|
||||
(symbol-value list)))
|
||||
(entry (completing-read
|
||||
prompt
|
||||
alist
|
||||
nil
|
||||
t)))
|
||||
(if (erc-member-ignore-case entry (symbol-value list))
|
||||
;; plain string
|
||||
(set list (delete entry (symbol-value list)))
|
||||
;; cons cell
|
||||
(set list (delete (assoc entry (symbol-value list))
|
||||
(symbol-value list))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-add-pal ()
|
||||
"Add pal interactively to `erc-pals'."
|
||||
(interactive)
|
||||
(erc-add-entry-to-list 'erc-pals "Add pal: " (erc-get-server-nickname-alist)))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-delete-pal ()
|
||||
"Delete pal interactively to `erc-pals'."
|
||||
(interactive)
|
||||
(erc-remove-entry-from-list 'erc-pals "Delete pal: "))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-add-fool ()
|
||||
"Add fool interactively to `erc-fools'."
|
||||
(interactive)
|
||||
(erc-add-entry-to-list 'erc-fools "Add fool: "
|
||||
(erc-get-server-nickname-alist)))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-delete-fool ()
|
||||
"Delete fool interactively to `erc-fools'."
|
||||
(interactive)
|
||||
(erc-remove-entry-from-list 'erc-fools "Delete fool: "))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-add-keyword ()
|
||||
"Add keyword interactively to `erc-keywords'."
|
||||
(interactive)
|
||||
(erc-add-entry-to-list 'erc-keywords "Add keyword: "))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-delete-keyword ()
|
||||
"Delete keyword interactively to `erc-keywords'."
|
||||
(interactive)
|
||||
(erc-remove-entry-from-list 'erc-keywords "Delete keyword: "))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-add-dangerous-host ()
|
||||
"Add dangerous-host interactively to `erc-dangerous-hosts'."
|
||||
(interactive)
|
||||
(erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: "))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-delete-dangerous-host ()
|
||||
"Delete dangerous-host interactively to `erc-dangerous-hosts'."
|
||||
(interactive)
|
||||
(erc-remove-entry-from-list 'erc-dangerous-hosts "Delete dangerous-host: "))
|
||||
|
||||
(defun erc-match-current-nick-p (nickuserhost msg)
|
||||
"Check whether the current nickname is in MSG.
|
||||
NICKUSERHOST will be ignored."
|
||||
(with-syntax-table erc-match-syntax-table
|
||||
(and msg
|
||||
(string-match (concat "\\b"
|
||||
(regexp-quote (erc-current-nick))
|
||||
"\\b")
|
||||
msg))))
|
||||
|
||||
(defun erc-match-pal-p (nickuserhost msg)
|
||||
"Check whether NICKUSERHOST is in `erc-pals'.
|
||||
MSG will be ignored."
|
||||
(and nickuserhost
|
||||
(erc-list-match erc-pals nickuserhost)))
|
||||
|
||||
(defun erc-match-fool-p (nickuserhost msg)
|
||||
"Check whether NICKUSERHOST is in `erc-fools' or MSG is directed at a fool."
|
||||
(and msg nickuserhost
|
||||
(or (erc-list-match erc-fools nickuserhost)
|
||||
(erc-match-directed-at-fool-p msg))))
|
||||
|
||||
(defun erc-match-keyword-p (nickuserhost msg)
|
||||
"Check whether any keyword of `erc-keywords' matches for MSG.
|
||||
NICKUSERHOST will be ignored."
|
||||
(and msg
|
||||
(erc-list-match
|
||||
(mapcar (lambda (x)
|
||||
(if (listp x)
|
||||
(car x)
|
||||
x))
|
||||
erc-keywords)
|
||||
msg)))
|
||||
|
||||
(defun erc-match-dangerous-host-p (nickuserhost msg)
|
||||
"Check whether NICKUSERHOST is in `erc-dangerous-hosts'.
|
||||
MSG will be ignored."
|
||||
(and nickuserhost
|
||||
(erc-list-match erc-dangerous-hosts nickuserhost)))
|
||||
|
||||
(defun erc-match-directed-at-fool-p (msg)
|
||||
"Check whether MSG is directed at a fool.
|
||||
In order to do this, every entry in `erc-fools' will be used.
|
||||
In any of the following situations, MSG is directed at an entry FOOL:
|
||||
|
||||
- MSG starts with \"FOOL: \" or \"FOO, \"
|
||||
- MSG contains \", FOOL.\" (actually, \"\\s. FOOL\\s.\")"
|
||||
(let ((fools-beg (mapcar (lambda (entry)
|
||||
(concat "^" entry "[:,] "))
|
||||
erc-fools))
|
||||
(fools-end (mapcar (lambda (entry)
|
||||
(concat "\\s. " entry "\\s."))
|
||||
erc-fools)))
|
||||
(or (erc-list-match fools-beg msg)
|
||||
(erc-list-match fools-end msg))))
|
||||
|
||||
(defun erc-get-parsed-vector (point)
|
||||
"Return the whole parsed vector on POINT."
|
||||
(get-text-property point 'erc-parsed))
|
||||
|
||||
(defun erc-get-parsed-vector-nick (vect)
|
||||
"Return nickname in the parsed vector VECT."
|
||||
(let* ((untreated-nick (and vect (erc-response.sender vect)))
|
||||
(maybe-nick (when untreated-nick
|
||||
(car (split-string untreated-nick "!")))))
|
||||
(when (and (not (null maybe-nick))
|
||||
(erc-is-valid-nick-p maybe-nick))
|
||||
untreated-nick)))
|
||||
|
||||
(defun erc-get-parsed-vector-type (vect)
|
||||
"Return message type in the parsed vector VECT."
|
||||
(and vect
|
||||
(erc-response.command vect)))
|
||||
|
||||
(defun erc-match-message ()
|
||||
"Mark certain keywords in a region.
|
||||
Use this defun with `erc-insert-modify-hook'."
|
||||
;; This needs some refactoring.
|
||||
(goto-char (point-min))
|
||||
(let* ((to-match-nick-dep '("pal" "fool" "dangerous-host"))
|
||||
(to-match-nick-indep '("keyword" "current-nick"))
|
||||
(vector (erc-get-parsed-vector (point-min)))
|
||||
(nickuserhost (erc-get-parsed-vector-nick vector))
|
||||
(nickname (and nickuserhost
|
||||
(nth 0 (erc-parse-user nickuserhost))))
|
||||
(old-pt (point))
|
||||
(nick-beg (and nickname
|
||||
(re-search-forward (regexp-quote nickname)
|
||||
(point-max) t)
|
||||
(match-beginning 0)))
|
||||
(nick-end (when nick-beg
|
||||
(match-end 0)))
|
||||
(message (buffer-substring (if (and nick-end
|
||||
(<= (+ 2 nick-end) (point-max)))
|
||||
(+ 2 nick-end)
|
||||
(point-min))
|
||||
(point-max))))
|
||||
(when vector
|
||||
(mapc
|
||||
(lambda (match-type)
|
||||
(goto-char (point-min))
|
||||
(let* ((match-prefix (concat "erc-" match-type))
|
||||
(match-pred (intern (concat "erc-match-" match-type "-p")))
|
||||
(match-htype (eval (intern (concat match-prefix
|
||||
"-highlight-type"))))
|
||||
(match-regex (if (string= match-type "current-nick")
|
||||
(regexp-quote (erc-current-nick))
|
||||
(eval (intern (concat match-prefix "s")))))
|
||||
(match-face (intern (concat match-prefix "-face"))))
|
||||
(when (funcall match-pred nickuserhost message)
|
||||
(cond
|
||||
;; Highlight the nick of the message
|
||||
((and (eq match-htype 'nick)
|
||||
nick-end)
|
||||
(erc-put-text-property
|
||||
nick-beg nick-end
|
||||
'face match-face (current-buffer)))
|
||||
;; Highlight the nick of the message, or the current
|
||||
;; nick if there's no nick in the message (e.g. /NAMES
|
||||
;; output)
|
||||
((and (string= match-type "current-nick")
|
||||
(eq match-htype 'nick-or-keyword))
|
||||
(if nick-end
|
||||
(erc-put-text-property
|
||||
nick-beg nick-end
|
||||
'face match-face (current-buffer))
|
||||
(goto-char (+ 2 (or nick-end
|
||||
(point-min))))
|
||||
(while (re-search-forward match-regex nil t)
|
||||
(erc-put-text-property (match-beginning 0) (match-end 0)
|
||||
'face match-face))))
|
||||
;; Highlight the whole message
|
||||
((eq match-htype 'all)
|
||||
(erc-put-text-property
|
||||
(point-min) (point-max)
|
||||
'face match-face (current-buffer)))
|
||||
;; Highlight all occurrences of the word to be
|
||||
;; highlighted.
|
||||
((and (string= match-type "keyword")
|
||||
(eq match-htype 'keyword))
|
||||
(mapc (lambda (elt)
|
||||
(let ((regex elt)
|
||||
(face match-face))
|
||||
(when (consp regex)
|
||||
(setq regex (car elt)
|
||||
face (cdr elt)))
|
||||
(goto-char (+ 2 (or nick-end
|
||||
(point-min))))
|
||||
(while (re-search-forward regex nil t)
|
||||
(erc-put-text-property
|
||||
(match-beginning 0) (match-end 0)
|
||||
'face face))))
|
||||
match-regex))
|
||||
;; Highlight all occurrences of our nick.
|
||||
((and (string= match-type "current-nick")
|
||||
(eq match-htype 'keyword))
|
||||
(goto-char (+ 2 (or nick-end
|
||||
(point-min))))
|
||||
(while (re-search-forward match-regex nil t)
|
||||
(erc-put-text-property (match-beginning 0) (match-end 0)
|
||||
'face match-face)))
|
||||
;; Else twiddle your thumbs.
|
||||
(t nil))
|
||||
(run-hook-with-args
|
||||
'erc-text-matched-hook
|
||||
(intern match-type)
|
||||
(or nickuserhost
|
||||
(concat "Server:" (erc-get-parsed-vector-type vector)))
|
||||
message))))
|
||||
(if nickuserhost
|
||||
(append to-match-nick-dep to-match-nick-indep)
|
||||
to-match-nick-indep)))))
|
||||
|
||||
(defun erc-log-matches (match-type nickuserhost message)
|
||||
"Log matches in a separate buffer, determined by MATCH-TYPE.
|
||||
The behaviour of this function is controlled by the variables
|
||||
`erc-log-matches-types-alist' and `erc-log-matches-flag'. Specify the
|
||||
match types which should be logged in the former, and
|
||||
deactivate/activate match logging in the latter. See
|
||||
`erc-log-match-format'."
|
||||
(let ((match-buffer-name (cdr (assq match-type
|
||||
erc-log-matches-types-alist)))
|
||||
(nick (nth 0 (erc-parse-user nickuserhost))))
|
||||
(when (and
|
||||
(or (eq erc-log-matches-flag t)
|
||||
(and (eq erc-log-matches-flag 'away)
|
||||
erc-away))
|
||||
match-buffer-name)
|
||||
(let ((line (format-spec erc-log-match-format
|
||||
(format-spec-make
|
||||
?n nick
|
||||
?t (format-time-string
|
||||
(or (and (boundp 'erc-timestamp-format)
|
||||
erc-timestamp-format)
|
||||
"[%Y-%m-%d %H:%M] "))
|
||||
?c (or (erc-default-target) "")
|
||||
?m message
|
||||
?u nickuserhost))))
|
||||
(with-current-buffer (erc-log-matches-make-buffer match-buffer-name)
|
||||
(toggle-read-only -1)
|
||||
(point-max)
|
||||
(insert line)
|
||||
(toggle-read-only 1))))))
|
||||
|
||||
(defun erc-log-matches-make-buffer (name)
|
||||
"Create or get a log-matches buffer named NAME and return it."
|
||||
(let* ((buffer-already (get-buffer name))
|
||||
(buffer (or buffer-already
|
||||
(get-buffer-create name))))
|
||||
(with-current-buffer buffer
|
||||
(unless buffer-already
|
||||
(insert " == Type \"q\" to dismiss messages ==\n")
|
||||
(erc-view-mode-enter nil (lambda (buffer)
|
||||
(when (y-or-n-p "Discard messages?")
|
||||
(kill-buffer buffer)))))
|
||||
buffer)))
|
||||
|
||||
(defun erc-log-matches-come-back (proc parsed)
|
||||
"Display a notice that messages were logged while away."
|
||||
(when (and erc-away
|
||||
(eq erc-log-matches-flag 'away))
|
||||
(mapc
|
||||
(lambda (match-type)
|
||||
(let ((buffer (get-buffer (cdr match-type)))
|
||||
(buffer-name (cdr match-type)))
|
||||
(when buffer
|
||||
(let* ((last-msg-time (erc-emacs-time-to-erc-time
|
||||
(with-current-buffer buffer
|
||||
(get-text-property (1- (point-max))
|
||||
'timestamp))))
|
||||
(away-time (erc-emacs-time-to-erc-time erc-away)))
|
||||
(when (and away-time last-msg-time
|
||||
(erc-time-gt last-msg-time away-time))
|
||||
(erc-display-message
|
||||
nil 'notice 'active
|
||||
(format "You have logged messages waiting in \"%s\"."
|
||||
buffer-name))
|
||||
(erc-display-message
|
||||
nil 'notice 'active
|
||||
(format "Type \"C-c C-k %s RET\" to view them."
|
||||
buffer-name)))))))
|
||||
erc-log-matches-types-alist))
|
||||
nil)
|
||||
|
||||
; This handler must be run _before_ erc-process-away is.
|
||||
(add-hook 'erc-server-305-functions 'erc-log-matches-come-back nil)
|
||||
|
||||
(defun erc-go-to-log-matches-buffer ()
|
||||
"Interactively open an erc-log-matches buffer."
|
||||
(interactive)
|
||||
(let ((buffer-name (completing-read "Switch to ERC Log buffer: "
|
||||
(mapcar (lambda (x)
|
||||
(cons (cdr x) t))
|
||||
erc-log-matches-types-alist)
|
||||
(lambda (buffer-cons)
|
||||
(get-buffer (car buffer-cons))))))
|
||||
(switch-to-buffer buffer-name)))
|
||||
|
||||
(define-key erc-mode-map "\C-c\C-k" 'erc-go-to-log-matches-buffer)
|
||||
|
||||
(defun erc-hide-fools (match-type nickuserhost message)
|
||||
"Hide foolish comments.
|
||||
This function should be called from `erc-text-matched-hook'."
|
||||
(when (eq match-type 'fool)
|
||||
(erc-put-text-properties (point-min) (point-max)
|
||||
'(invisible intangible)
|
||||
(current-buffer))))
|
||||
|
||||
(defun erc-beep-on-match (match-type nickuserhost message)
|
||||
"Beep when text matches.
|
||||
This function is meant to be called from `erc-text-matched-hook'."
|
||||
(when (member match-type erc-beep-match-types)
|
||||
(beep)))
|
||||
|
||||
(provide 'erc-match)
|
||||
|
||||
;;; erc-match.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 1f1f595e-abcc-4b0b-83db-598a1d3f0f82
|
||||
121
lisp/erc/erc-menu.el
Normal file
121
lisp/erc/erc-menu.el
Normal file
|
|
@ -0,0 +1,121 @@
|
|||
;; erc-menu.el -- Menu-bar definitions for ERC
|
||||
|
||||
;; Copyright (C) 2001, 2002, 2004, 2005 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
;; Keywords: comm, processes, menu
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcMenu
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Loading this file defines a menu for ERC.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'easymenu)
|
||||
|
||||
(defvar erc-menu-definition
|
||||
(list "IRC"
|
||||
["Connect to server..." erc-select t]
|
||||
["Disconnect from server..." erc-quit-server erc-server-connected]
|
||||
"-"
|
||||
["List channels..." erc-cmd-LIST
|
||||
(and erc-server-connected (fboundp 'erc-cmd-LIST))]
|
||||
["Join channel..." erc-join-channel erc-server-connected]
|
||||
["Start a query..." erc-cmd-QUERY erc-server-connected]
|
||||
"-"
|
||||
["List users in channel" erc-channel-names erc-channel-users]
|
||||
["List channel operators" erc-cmd-OPS erc-channel-users]
|
||||
["Input action..." erc-input-action (erc-default-target)]
|
||||
["Set topic..." erc-set-topic
|
||||
(and (and (erc-default-target) (not (erc-query-buffer-p)))
|
||||
(or (not (member "t" erc-channel-modes))
|
||||
(erc-channel-user-op-p (erc-current-nick))))]
|
||||
(list "Channel modes"
|
||||
["Change mode..." erc-insert-mode-command
|
||||
(erc-channel-user-op-p (erc-current-nick))]
|
||||
["No external send" (erc-toggle-channel-mode "n")
|
||||
:active (erc-channel-user-op-p (erc-current-nick))
|
||||
:style toggle :selected (member "n" erc-channel-modes)]
|
||||
["Topic set by channel operator" (erc-toggle-channel-mode "t")
|
||||
:style toggle :selected (member "t" erc-channel-modes)
|
||||
:active (erc-channel-user-op-p (erc-current-nick))]
|
||||
["Invite only" (erc-toggle-channel-mode "i")
|
||||
:style toggle :selected (member "i" erc-channel-modes)
|
||||
:active (erc-channel-user-op-p (erc-current-nick))]
|
||||
["Private" (erc-toggle-channel-mode "p")
|
||||
:style toggle :selected (member "p" erc-channel-modes)
|
||||
:active (erc-channel-user-op-p (erc-current-nick))]
|
||||
["Secret" (erc-toggle-channel-mode "s")
|
||||
:style toggle :selected (member "s" erc-channel-modes)
|
||||
:active (erc-channel-user-op-p (erc-current-nick))]
|
||||
["Moderated" (erc-toggle-channel-mode "m")
|
||||
:style toggle :selected (member "m" erc-channel-modes)
|
||||
:active (erc-channel-user-op-p (erc-current-nick))]
|
||||
["Set a limit..." erc-set-channel-limit
|
||||
(erc-channel-user-op-p (erc-current-nick))]
|
||||
["Set a key..." erc-set-channel-key
|
||||
(erc-channel-user-op-p (erc-current-nick))])
|
||||
["Leave this channel..." erc-part-from-channel erc-channel-users]
|
||||
"-"
|
||||
(list "Pals, fools and other keywords"
|
||||
["Add pal..." erc-add-pal]
|
||||
["Delete pal..." erc-delete-pal]
|
||||
["Add fool..." erc-add-fool]
|
||||
["Delete fool..." erc-delete-fool]
|
||||
["Add keyword..." erc-add-keyword]
|
||||
["Delete keyword..." erc-delete-keyword]
|
||||
["Add dangerous host..." erc-add-dangerous-host]
|
||||
["Delete dangerous host..." erc-delete-dangerous-host])
|
||||
"-"
|
||||
(list "IRC services"
|
||||
["Identify to NickServ..." erc-nickserv-identify
|
||||
(and erc-server-connected (functionp 'erc-nickserv-identify))])
|
||||
"-"
|
||||
["Save buffer in log" erc-save-buffer-in-logs
|
||||
(fboundp 'erc-save-buffer-in-logs)]
|
||||
["Truncate buffer" erc-truncate-buffer (fboundp 'erc-truncate-buffer)]
|
||||
"-"
|
||||
["Customize ERC" (customize-group 'erc) t]
|
||||
["Enable/Disable ERC Modules" (customize-variable 'erc-modules) t]
|
||||
["Show ERC version" erc-version t])
|
||||
"ERC menu definition.")
|
||||
|
||||
;; `erc-mode-map' must be defined before doing this
|
||||
(eval-after-load "erc"
|
||||
'(progn
|
||||
(easy-menu-define erc-menu erc-mode-map "ERC menu" erc-menu-definition)
|
||||
(easy-menu-add erc-menu erc-mode-map)
|
||||
|
||||
;; for some reason the menu isn't automatically added to the menu bar
|
||||
(when (featurep 'xemacs)
|
||||
(add-hook 'erc-mode-hook
|
||||
(lambda () (easy-menu-add erc-menu erc-mode-map))))))
|
||||
|
||||
(provide 'erc-menu)
|
||||
|
||||
;;; erc-menu.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 671219f2-b082-4753-a185-1d0c7e0c05bd
|
||||
861
lisp/erc/erc-nets.el
Normal file
861
lisp/erc/erc-nets.el
Normal file
|
|
@ -0,0 +1,861 @@
|
|||
;;; erc-nets.el --- IRC networks
|
||||
|
||||
;; Copyright (C) 2002, 2004, 2005 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@lexx.delysid.org>
|
||||
;; Keywords: comm
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file deals with IRC networks.
|
||||
;;
|
||||
;; Usage:
|
||||
;;
|
||||
;; Put into your .emacs:
|
||||
;;
|
||||
;; (require 'erc-nets)
|
||||
;;
|
||||
;; M-x erc-server-select provides an alternative way to connect to servers by
|
||||
;; choosing networks.
|
||||
;; You can use (eq (erc-network) 'Network) if you'd like to set variables or do
|
||||
;; certain actions according to which network you're connected to.
|
||||
;; If a network you use is not listed in `erc-networks-alist', you can put
|
||||
;; (add-to-list 'erc-networks-alist '(Network "irc.server-name.net")) in your
|
||||
;; config file.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;; Variables
|
||||
|
||||
(defgroup erc-networks nil
|
||||
"IRC Networks"
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-server-alist
|
||||
'(("4-irc: Random server" 4-irc "4-irc.com" 6667)
|
||||
("A5KNet: Random server" A5KNet "irc.a5knet.com" ((6660 6669)))
|
||||
("AbleNet: Random server" AbleNet "irc.ablenet.org" 6667)
|
||||
("Accessirc: Random server" Accessirc "irc.accessirc.net" 6667)
|
||||
("Acestar: Random server" Acestar "irc.acestar.org" 6667)
|
||||
("Action-IRC: Random server" Action-IRC "irc.action-irc.net" ((6660 6669)))
|
||||
("AfterNET: Random server" AfterNET "irc.afternet.org" 6667)
|
||||
("Alternativenet: Random server" Alternativenet "irc.altnet.org" 6667)
|
||||
("AmigaNet: Random server" AmigaNet "irc.amiganet.org" 6667)
|
||||
("AngelEyez: Random server" AngelEyez "irc.angeleyez.net" ((6666 7000)))
|
||||
("AnotherNet: Random server" Anothernet "irc.another.net" (6667 7000 ))
|
||||
("ArabChat: Random server" ArabChat "irc.arabchat.org" ((6660 6667)))
|
||||
("AsiaTalk: Random server" AsiaTalk "irc.asiatalk.org" ((6667 6669) 7000 ))
|
||||
("AstroLink: Random server" AstroLink "irc.astrolink.org" ((6660 6667)))
|
||||
("Asylumnet: Random server" Asylumnet "irc.asylum-net.org" ((6661 6669) 7000 7777 ))
|
||||
("Austnet: Random AU server" Austnet "au.austnet.org" 6667)
|
||||
("Austnet: Random NZ server" Austnet "nz.austnet.org" 6667)
|
||||
("Austnet: Random SG server" Austnet "sg.austnet.org" 6667)
|
||||
("Austnet: Random US server" Austnet "us.austnet.org" 6667)
|
||||
("AwesomeChat: Random server" AwesomeChat "irc.awesomechat.net" ((6661 6669)))
|
||||
("Awesomechristians: Random server" Awesomechristians "irc.awesomechristians.com" 7000)
|
||||
("Axenet: Random server" Axenet "irc.axenet.org" ((6660 6667)))
|
||||
("BeyondIRC: Random server" Beyondirc "irc.beyondirc.net" ((6660 6669)))
|
||||
("BGIRC: Random server" BGIRC "irc.bulgaria.org" ((6666 6669) 7000 ))
|
||||
("Blabbernet: Random server" Blabbernet "irc.blabber.net" (6667 7000 ))
|
||||
("Blitzed: Random server" Blitzed "irc.blitzed.org" (6667 7000 ))
|
||||
("Brasirc: Random server" Brasirc "irc.brasirc.net" ((6666 6667)))
|
||||
("Brasirc: BR, PA, Belem" Brasirc "irc.libnet.com.br" ((6666 6668) 7777 8002 ))
|
||||
("BRASnet: Random European server" BRASnet "eu.brasnet.org" ((6665 6669)))
|
||||
("BRASnet: Random US server" BRASnet "us.brasnet.org" ((6665 6669)))
|
||||
("BubbleNet: Random server" BubbleNet "irc.bubblenet.org" ((6667 6669)))
|
||||
("CCnet: Random server" CCnet "irc.cchat.net" (6667 7000 ))
|
||||
("CCnet: US, TX, Dallas" CCnet "irc2.cchat.net" (6667 7000 ))
|
||||
("Chat-Net: Random server" Chat-Net "irc.chat-net.org" 6667)
|
||||
("Chat-Solutions: Random server" Chat-Solutions "irc.chat-solutions.org" 6667)
|
||||
("Chatcafe: Random server" Chatcafe "irc.chatcafe.net" 6667)
|
||||
("Chatchannel: Random server" Chatchannel "irc.chatchannel.org" ((6666 6669) 7000 ))
|
||||
("ChatCircuit: Random server" ChatCircuit "irc.chatcircuit.com" 6668)
|
||||
("Chatlink: Random server" Chatlink "irc.chatlink.org" 6667)
|
||||
("Chatnet: Random AU server" Chatnet "au.chatnet.org" 6667)
|
||||
("Chatnet: Random EU server" Chatnet "eu.chatnet.org" 6667)
|
||||
("Chatnet: Random US server" Chatnet "us.chatnet.org" 6667)
|
||||
("ChatNut: Random server" ChatNut "irc.chatnut.net" (6667 7000 ))
|
||||
("Chatpinoy: Random server" Chatpinoy "irc.chatpinoy.com" 6667)
|
||||
("ChatPR: Random server" ChatPR "irc.chatpr.org" 6667)
|
||||
("Chatroom: Random server" Chatroom "irc.chatroom.org" 6667)
|
||||
("Chatster: Random server" Chatster "irc.chatster.org" 6667)
|
||||
("ChatX: Random server" ChatX "irc.chatx.net" 6667)
|
||||
("China263: Random server" China263 "irc.263.net" 6667)
|
||||
("Cineplex1: Random server" Cineplex1 "irc.cineplex1.com" ((6666 6668)))
|
||||
("CNN: CNN News discussions" CNN "chat.cnn.com" ((6667 6669) 7000 ))
|
||||
("CobraNet: Random server" CobraNet "irc.cobra.net" 6667)
|
||||
("Coolchat: Random server" Coolchat "irc.coolchat.net" 6667)
|
||||
("Criten: Random server" Criten "irc.criten.net" 6667)
|
||||
("Cyberchat: Random server" Cyberchat "irc.cyberchat.org" (6667 6668 ))
|
||||
("CyGanet: Random server" CyGanet "irc.cyga.net" 6667)
|
||||
("DALnet: AS, MY, Coins" DALnet "coins.dal.net" ((6663 6668) 7000 ))
|
||||
("DALnet: CA, ON, Sodre" DALnet "sodre.on.ca.dal.net" ((6661 6669) 7000 ))
|
||||
("DALnet: EU, DE, Nexgo" DALnet "nexgo.de.eu.dal.net" ((6664 6669) 7000 ))
|
||||
("DALnet: EU, NO, Powertech" DALnet "powertech.no.eu.dal.net" ((6666 6667) 7000 ))
|
||||
("DALnet: EU, SE, Borg" DALnet "borg.se.eu.dal.net" (6667 7000 ))
|
||||
("DALnet: EU, SE, Ced" DALnet "ced.se.eu.dal.net" (6667 7000 ))
|
||||
("DALnet: US, GA, Astro" DALnet "astro.ga.us.dal.net" ((6661 6669) 7000 ))
|
||||
("DALnet: US, GA, Dragons" DALnet "dragons.ga.us.dal.net" ((6661 6669) 7000 ))
|
||||
("DALnet: US, GA, Elysium" DALnet "elysium.ga.us.dal.net" ((6661 6669) 7000 ))
|
||||
("DALnet: US, MA, Twisted" DALnet "twisted.ma.us.dal.net" ((6660 6669) 7001 7002 ))
|
||||
("DALnet: US, MO, Global" DALnet "global.mo.us.dal.net" ((6661 6669) 7000 ))
|
||||
("DALnet: US, NJ, Liberty" DALnet "liberty.nj.us.dal.net" ((6662 6669) 7000 ))
|
||||
("DALnet: US, VA, Wombat" DALnet "wombat.va.us.dal.net" ((6661 6669) 7000 ))
|
||||
("DALnet: Random EU server" DALnet "irc.eu.dal.net" 6667)
|
||||
("DALnet: Random US server" DALnet "irc.dal.net" ((6660 6667)))
|
||||
("Dark-Tou-Net: Random server" Dark-Tou-Net "irc.d-t-net.de" 6667)
|
||||
("Darkfire: Random server" Darkfire "irc.darkfire.net" (6667 7000 8000 ))
|
||||
("DarkMyst: Random server" DarkMyst "irc.darkmyst.org" 6667)
|
||||
("Darkserv: Random server" Darkserv "irc.darkserv.net" 6667)
|
||||
("Darksystem: Random server" Darksystem "irc.darksystem.com" 6667)
|
||||
("Darktree: Random server" Darktree "irc.darktree.net" 6667)
|
||||
("DayNet: Random server" DayNet "irc.daynet.org" 6667)
|
||||
("Deepspace: Disability network" Deepspace "irc.deepspace.org" 6667)
|
||||
("Different: Random server" Different "irc.different.net" 6667)
|
||||
("Digarix: Random server" Digarix "irc.digarix.net" 6667)
|
||||
("Digatech: Random server" Digatech "irc.digatech.net" 6667)
|
||||
("Digital-Base: Random server" Digital-Base "irc.digital-base.net" ((6660 7000)))
|
||||
("Digitalirc: Random server" Digitalirc "irc.digitalirc.net" 6667)
|
||||
("Discussioni: Random server" Discussioni "irc.discussioni.org" ((6666 6669)))
|
||||
("DorukNet: TR, Istanbul" DorukNet "irc.doruk.net.tr" ((6660 6669) 7000 8888 ))
|
||||
("Dreamcast: Random server" Dreamcast "irc0.dreamcast.com" 6667)
|
||||
("DWChat: Random server" DWChat "irc.dwchat.net" 6667)
|
||||
("Dynastynet: Random server" Dynastynet "irc.dynastynet.net" 6667)
|
||||
("EFnet: CA, AB, Edmonton (arcti)" EFnet "irc.arcti.ca" 6667)
|
||||
("EFnet: CA, AB, Edmonton (mpls)" EFnet "irc.mpls.ca" ((6660 6669)))
|
||||
("EFnet: CA, ON, Toronto" EFnet "irc2.magic.ca" 6667)
|
||||
("EFnet: CA, QB, Montreal" EFnet "irc.qeast.net" 6667)
|
||||
("EFnet: EU, DK, Aarhus" EFnet "irc.inet.tele.dk" 6667)
|
||||
("EFnet: EU, FI, Helsinki" EFnet "efnet.cs.hut.fi" 6667)
|
||||
("EFnet: EU, FR, Paris" EFnet "irc.isdnet.fr" ((6667 6669)))
|
||||
("EFnet: EU, NL, Amsterdam" EFnet "efnet.vuurwerk.nl" 6667)
|
||||
("EFnet: EU, NO, Homelien" EFnet "irc.homelien.no" (5190 (6666 6667) (7000 7001) ))
|
||||
("EFnet: EU, NO, Oslo" EFnet "irc.daxnet.no" ((6666 7000)))
|
||||
("EFnet: EU, PL, Warszawa" EFnet "irc.efnet.pl" 6667)
|
||||
("EFnet: EU, RU, Moscow" EFnet "irc.rt.ru" ((6661 6669)))
|
||||
("EFnet: EU, SE, Dalarna" EFnet "irc.du.se" ((6666 6669)))
|
||||
("EFnet: EU, SE, Gothenberg" EFnet "irc.hemmet.chalmers.se" ((6666 7000)))
|
||||
("EFnet: EU, SE, Sweden" EFnet "irc.light.se" 6667)
|
||||
("EFnet: EU, UK, London (carrier)" EFnet "irc.carrier1.net.uk" ((6666 6669)))
|
||||
("EFnet: EU, UK, London (demon)" EFnet "efnet.demon.co.uk" ((6665 6669)))
|
||||
("EFnet: ME, IL, Inter" EFnet "irc.inter.net.il" ((6665 6669)))
|
||||
("EFnet: US, AZ, Phoenix" EFnet "irc.easynews.com" (6660 (6665 6667) 7000 ))
|
||||
("EFnet: US, CA, San Jose" EFnet "irc.concentric.net" ((6665 6668)))
|
||||
("EFnet: US, CA, San Luis Obispo" EFnet "irc.prison.net" ((6666 6667)))
|
||||
("EFnet: US, GA, Atlanta" EFnet "irc.mindspring.com" ((6660 6669)))
|
||||
("EFnet: US, MI, Ann Arbor" EFnet "irc.umich.edu" 6667)
|
||||
("EFnet: US, MN, Twin Cities" EFnet "irc.umn.edu" ((6665 6669)))
|
||||
("EFnet: US, NY, Mineola" EFnet "irc.lightning.net" ((6665 7000)))
|
||||
("EFnet: US, NY, New York (east)" EFnet "irc.east.gblx.net" 6667)
|
||||
("EFnet: US, NY, New York (flamed)" EFnet "irc.flamed.net" ((6665 6669)))
|
||||
("EFnet: US, TX, Houston" EFnet "ircd.lagged.org" ((6660 6669)))
|
||||
("EFnet: US, VA, Ashburn" EFnet "irc.secsup.uu.net" ((6665 6669) 8080 ))
|
||||
("EFnet: Random AU server" EFnet "au.rr.efnet.net" 6667)
|
||||
("EFnet: Random CA server" EFnet "ca.rr.efnet.net" 6667)
|
||||
("EFnet: Random EU server" EFnet "eu.rr.efnet.net" 6667)
|
||||
("EFnet: Random US server" EFnet "us.rr.efnet.net" 6667)
|
||||
("EgyptianIRC: Random server" EgyptianIRC "irc.egyptianirc.net" ((6667 6669)))
|
||||
("Eircnet: Random server" Eircnet "irc.eircnet.org" ((6660 6669) 7000 ))
|
||||
("Eleethal: Random server" Eleethal "irc.eleethal.com" ((6660 6669) 7000 ))
|
||||
("EntertheGame: Random server" EntertheGame "irc.enterthegame.com" ((6667 6669)))
|
||||
("EpiKnet: Random server" EpiKnet "irc.epiknet.org" ((6660 6669) 7000 7001 ))
|
||||
("EsperNet: Random server" EsperNet "irc.esper.net" (5555 (6667 6669) ))
|
||||
("Esprit: Random server" Esprit "irc.esprit.net" 6667)
|
||||
("euIRC: Random server" euIRC "irc.euirc.net" ((6665 6669)))
|
||||
("Evilzinc: Random server" Evilzinc "irc.evilzinc.net" ((6660 6669) 7000 8000 ))
|
||||
("ExodusIRC: Random server" ExodusIRC "irc.exodusirc.net" ((6660 6669)))
|
||||
("FDFnet: Random server" FDFnet "irc.fdfnet.net" ((6666 6668) 9999 ))
|
||||
("FEFnet: Random server" FEFnet "irc.fef.net" 6667)
|
||||
("Financialchat: Random server" Financialchat "irc.financialchat.com" ((6667 6669) 7000 ))
|
||||
("Forestnet: Random server" Forestnet "irc.forestnet.org" (6667 7000 ))
|
||||
("ForeverChat: Random server" ForeverChat "irc.foreverchat.net" ((6660 6669) 7000 ))
|
||||
("Fraggers: Random server" Fraggers "irc.fraggers.co.uk" ((6661 6669) (7000 7001) ))
|
||||
("FreedomChat: Random server" FreedomChat "chat.freedomchat.net" 6667)
|
||||
("FreedomIRC: Random server" FreedomIRC "irc.freedomirc.net" 6667)
|
||||
("Freenode: Random server" freenode "irc.freenode.net" 6667)
|
||||
("Freenode: Random EU server" freenode "irc.eu.freenode.net" 6667)
|
||||
("Freenode: Random US server" freenode "irc.us.freenode.net" 6667)
|
||||
("FunNet: Random server" FunNet "irc.funnet.org" 6667)
|
||||
("Galaxynet: Random server" GalaxyNet "irc.galaxynet.org" ((6662 6668) 7000 ))
|
||||
("Galaxynet: AU, NZ, Auckland" GalaxyNet "auckland.nz.galaxynet.org" ((6661 6669)))
|
||||
("Galaxynet: EU, BE, Online" GalaxyNet "online.be.galaxynet.org" ((6661 6669)))
|
||||
("Galaxynet: US, FL, Florida" GalaxyNet "gymnet.us.galaxynet.org" ((6661 6669)))
|
||||
("Gamesnet: Random east US server" Gamesnet "east.gamesnet.net" 6667)
|
||||
("Gamesnet: Random west US server" Gamesnet "west.gamesnet.net" 6667)
|
||||
("GammaForce: Random server" GammaForce "irc.gammaforce.org" ((6660 6669) 7000 ))
|
||||
("GIKInet: Random server" GIKInet "irc.giki.edu.pk" 6667)
|
||||
("GizNet: Random server" GizNet "irc.giznet.org" ((6666 6669) 7000 ))
|
||||
("Globalchat: Random server" Globalchat "irc.globalchat.org" 6667)
|
||||
("GlobIRC: Random server" GlobIRC "irc.globirc.net" ((6666 6668) 9999 ))
|
||||
("Goldchat: Random server" Goldchat "irc.goldchat.nl" ((6660 6669) 7000 ))
|
||||
("Goodchatting: Random server" Goodchatting "irc.goodchatting.com" ((6661 6669) 7000 ))
|
||||
("GravityLords: Random server" GravityLords "irc.gravitylords.net" 6667)
|
||||
("Grnet: Random EU server" GRnet "gr.irc.gr" (6667 7000 ))
|
||||
("Grnet: Random server" GRnet "srv.irc.gr" (6667 7000 ))
|
||||
("Grnet: Random US server" GRnet "us.irc.gr" (6667 7000 ))
|
||||
("GulfChat: Random server" GulfChat "irc.gulfchat.net" ((6660 6669)))
|
||||
("HabberNet: Random server" HabberNet "irc.habber.net" 6667)
|
||||
("HanIRC: Random server" HanIRC "irc.hanirc.org" 6667)
|
||||
("Hellenicnet: Random server" Hellenicnet "irc.mirc.gr" (6667 7000 ))
|
||||
("IceNet: Random server" IceNet "irc.icenet.org.za" 6667)
|
||||
("ICQnet: Random server" ICQnet "irc.icq.com" 6667)
|
||||
("Infatech: Random server" Infatech "irc.infatech.net" ((6660 6669)))
|
||||
("Infinity: Random server" Infinity "irc.infinity-irc.org" 6667)
|
||||
("Infomatrix: Random server" Infomatrix "irc.infomatrix.net" 6667)
|
||||
("Inside3D: Random server" Inside3D "irc.inside3d.net" ((6661 6669)))
|
||||
("InterlinkChat: Random server" InterlinkChat "irc.interlinkchat.net" ((6660 6669) 7000 ))
|
||||
("IRC-Chile: Random server" IRC-Chile "irc.cl" 6667)
|
||||
("IRC-Hispano: Random server" IRC-Hispano "irc.irc-hispano.org" 6667)
|
||||
("IRCchat: Random server" IRCchat "irc.ircchat.tk" 6667)
|
||||
("IRCGate: Random server" IRCGate "irc.ircgate.net" ((6667 6669)))
|
||||
("IRCGeeks: Random server" IRCGeeks "irc.ircgeeks.org" ((6660 6669)))
|
||||
("IRChat: Random server" IRChat "irc.irchat.net" ((6660 6669)))
|
||||
("IrcLordz: Random server" IrcLordz "irc.irclordz.com" 6667)
|
||||
("IrcMalta: Random server" IrcMalta "irc.ircmalta.org" ((6660 6667)))
|
||||
("IRCnet: EU, FR, Random" IRCnet "irc.fr.ircnet.net" 6667)
|
||||
("IRCnet: EU, IT, Random" IRCnet "irc.ircd.it" ((6665 6669)))
|
||||
("IRCnet: AS, IL, Haifa" IRCnet "ircnet.netvision.net.il" ((6661 6668)))
|
||||
("IRCnet: AS, JP, Tokyo" IRCnet "irc.tokyo.wide.ad.jp" 6667)
|
||||
("IRCnet: AS, TW, Seed" IRCnet "irc.seed.net.tw" 6667)
|
||||
("IRCnet: EU, AT, Linz" IRCnet "linz.irc.at" ((6666 6668)))
|
||||
("IRCnet: EU, AT, Wien" IRCnet "vienna.irc.at" ((6666 6669)))
|
||||
("IRCnet: EU, BE, Brussels" IRCnet "irc.belnet.be" 6667)
|
||||
("IRCnet: EU, BE, Zaventem" IRCnet "ircnet.wanadoo.be" ((6661 6669)))
|
||||
("IRCnet: EU, CZ, Prague" IRCnet "irc.felk.cvut.cz" 6667)
|
||||
("IRCnet: EU, DE, Berlin" IRCnet "irc.fu-berlin.de" ((6665 6669)))
|
||||
("IRCnet: EU, DE, Dusseldorf" IRCnet "irc.freenet.de" ((6665 6669)))
|
||||
("IRCnet: EU, DE, Stuttgart" IRCnet "irc.belwue.de" ((6665 6669)))
|
||||
("IRCnet: EU, DK, Copenhagen" IRCnet "irc.ircnet.dk" 6667)
|
||||
("IRCnet: EU, EE, Tallinn" IRCnet "irc.estpak.ee" ((6666 6668)))
|
||||
("IRCnet: EU, FI, Helsinki" IRCnet "irc.cs.hut.fi" 6667)
|
||||
("IRCnet: EU, GR, Thessaloniki" IRCnet "irc.ee.auth.gr" ((6666 6669)))
|
||||
("IRCnet: EU, HU, Budapest" IRCnet "irc.elte.hu" 6667)
|
||||
("IRCnet: EU, IS, Reykjavik (ircnet)" IRCnet "irc.ircnet.is" ((6661 6669)))
|
||||
("IRCnet: EU, IS, Reykjavik (simnet)" IRCnet "irc.simnet.is" ((6661 6669)))
|
||||
("IRCnet: EU, IT, Rome" IRCnet "irc.tin.it" ((6665 6669)))
|
||||
("IRCnet: EU, NL, Amsterdam (nlnet)" IRCnet "irc.nl.uu.net" ((6660 6669)))
|
||||
("IRCnet: EU, NL, Amsterdam (xs4all)" IRCnet "irc.xs4all.nl" ((6660 6669)))
|
||||
("IRCnet: EU, NL, Enschede" IRCnet "irc.snt.utwente.nl" ((6660 6669)))
|
||||
("IRCnet: EU, NL, Nijmegen" IRCnet "irc.sci.kun.nl" ((6660 6669)))
|
||||
("IRCnet: EU, NO, Oslo" IRCnet "irc.ifi.uio.no" 6667)
|
||||
("IRCnet: EU, NO, Trondheim" IRCnet "irc.pvv.ntnu.no" 6667)
|
||||
("IRCnet: EU, PL, Lublin" IRCnet "lublin.irc.pl" ((6666 6668)))
|
||||
("IRCnet: EU, PL, Warsaw" IRCnet "warszawa.irc.pl" ((6666 6668)))
|
||||
("IRCnet: EU, RU, Moscow" IRCnet "irc.msu.ru" 6667)
|
||||
("IRCnet: EU, SE, Lulea" IRCnet "irc.ludd.luth.se" ((6661 6669)))
|
||||
("IRCnet: EU, UK, London (Demon)" IRCnet "ircnet.demon.co.uk" ((6665 6669)))
|
||||
("IRCnet: EU, UK, London (Easynet)" IRCnet "ircnet.easynet.co.uk" ((6666 6669)))
|
||||
("IRCnet: US, NY, New York" IRCnet "irc.stealth.net" ((6660 6669)))
|
||||
("IRCnet: Random AU server" IRCnet "au.ircnet.org" 6667)
|
||||
("IRCnet: Random EU server" IRCnet "eu.ircnet.org" ((6665 6668)))
|
||||
("IRCnet: Random US server" IRCnet "us.ircnet.org" ((6665 6668)))
|
||||
("IRCSoulZ: Random server" IRCSoulZ "irc.ircsoulz.net" 6667)
|
||||
("IRCSul: BR, PR, Maringa" IRCSul "irc.wnet.com.br" 6667)
|
||||
("IrcTalk: Random server" IrcTalk "irc.irctalk.net" ((6660 6669)))
|
||||
("Irctoo: Random server" Irctoo "irc.irctoo.net" 6667)
|
||||
("IRCtown: Random server" IRCtown "irc.irctown.net" ((6666 6669) 7000 ))
|
||||
("IRCworld: Random server" IRCworld "irc.ircworld.org" 6667)
|
||||
("ircXtreme: Random server" ircXtreme "irc.ircXtreme.net" ((6660 6669)))
|
||||
("Israelnet: Random server" Israelnet "irc.israel.net" 6667)
|
||||
("K0wNet: Random server" K0wNet "irc.k0w.net" ((6660 6669)))
|
||||
("KDFSnet: Random server" KDFSnet "irc.kdfs.net" ((6667 6669)))
|
||||
("Kemik: Random server" Kemik "irc.kemik.net" 6667)
|
||||
("Kewl.Org: Random server" Kewl.Org "irc.kewl.org" (6667 7000 ))
|
||||
("Kickchat: Random server" Kickchat "irc.kickchat.com" ((6660 6669) 7000 ))
|
||||
("Kidsworld: Random server" KidsWorld "irc.kidsworld.org" ((6666 6669)))
|
||||
("Knightnet: AF, ZA, Durban" Knightnet "orc.dbn.za.knightnet.net" (6667 5555 ))
|
||||
("Knightnet: US, CA, Goldengate" Knightnet "goldengate.ca.us.knightnet.net" (6667 5555 ))
|
||||
("Konfido.Net: Random server" Konfido.Net "irc.konfido.net" 6667)
|
||||
("KreyNet: Random server" Kreynet "irc.krey.net" 6667)
|
||||
("Krono: Random server" Krono "irc.krono.net" ((6660 6669) 7000 ))
|
||||
("Krushnet: Random server" Krushnet "irc.krushnet.org" 6667)
|
||||
("LagNet: Random server" LagNet "irc.lagnet.org.za" 6667)
|
||||
("LagNet: AF, ZA, Cape Town" LagNet "reaper.lagnet.org.za" 6667)
|
||||
("LagNet: AF, ZA, Johannesburg" LagNet "mystery.lagnet.org.za" 6667)
|
||||
("Librenet: Random server" Librenet "irc.librenet.net" 6667)
|
||||
("LinkNet: Random server" LinkNet "irc.link-net.org" ((6667 6669)))
|
||||
("Liquidized: Random server" Liquidized "irc.liquidized.net" (6667 7000 ))
|
||||
("M-IRC: Random server" M-IRC "irc.m-sys.org" ((6667 6669)))
|
||||
("MagicStar: Random server" MagicStar "irc.magicstar.net" 6667)
|
||||
("Mavra: Random server" Mavra "irc.mavra.net" 6667)
|
||||
("MediaDriven: Random server" MediaDriven "irc.mediadriven.com" ((6667 6669)))
|
||||
("mIRC-X: Random server" mIRC-X "irc.mircx.com" (6667 7000 ))
|
||||
("Morat: Random server" Morat "irc.morat.net" 6667)
|
||||
("MusicCity: Random server" MusicCity "chat.musiccity.com" 6667)
|
||||
("Mysteria: Random server" Mysteria "irc.mysteria.net" (6667 7000 ))
|
||||
("Mysterychat: Random server" Mysterychat "irc.mysterychat.net" ((6667 6669)))
|
||||
("Mystical: Random server" Mystical "irc.mystical.net" (6667 7000 ))
|
||||
("Narancs: Random server" Narancs "irc.narancs.com" ((6667 6669) 7000 ))
|
||||
("Net-France: Random server" Net-France "irc.net-france.com" 6667)
|
||||
("Nevernet: Random server" Nevernet "irc.nevernet.net" 6667)
|
||||
("Newnet: Random server" Newnet "irc.newnet.net" ((6665 6667)))
|
||||
("Nexusirc: Random server" Nexusirc "irc.nexusirc.org" 6667)
|
||||
("Nightstar: Random server" NightStar "irc.nightstar.net" ((6665 6669)))
|
||||
("NitrousNet: Random server" NitrousNet "irc.nitrousnet.net" 6667)
|
||||
("Novernet: Random server" Novernet "irc.novernet.com" ((6665 6669) 7000 ))
|
||||
("Nullrouted: Random server" Nullrouted "irc.nullrouted.org" ((6666 6669) 7000 ))
|
||||
("NullusNet: Random server" NullusNet "irc.nullus.net" 6667)
|
||||
("OpChat: Random server" OpChat "irc.opchat.org" ((6667 6669)))
|
||||
("Othernet: Random server" Othernet "irc.othernet.org" 6667)
|
||||
("Othernet: US, FL, Miami" Othernet "miami.fl.us.othernet.org" 6667)
|
||||
("Othernet: US, MO, StLouis" Othernet "stlouis.mo.us.othernet.org" 6667)
|
||||
("Otherside: Random server" OtherSide "irc.othersideirc.net" 6667)
|
||||
("Outsiderz: Random server" Outsiderz "irc.outsiderz.com" 6667)
|
||||
("OzOrg: AU, Perth" OzOrg "iinet.perth.oz.org" 6667)
|
||||
("Peacefulhaven: Random server" Peacefulhaven "irc.peacefulhaven.net" ((6660 6669) 7000 ))
|
||||
("PhazedIRC: Random server" PhazedIRC "irc.phazedirc.net" 6667)
|
||||
("Philchat: Random server" Philchat "irc.philchat.net" 6667)
|
||||
("phrozN: Random server" phrozN "irc.phrozn.net" 6667)
|
||||
("PiNet: Random server" PiNet "irc.praetorians.org" ((6665 6669)))
|
||||
("Pinoycentral: Random server" Pinoycentral "chat.abs-cbn.com" 6667)
|
||||
("Planetarion: Random server" Planetarion "irc.planetarion.com" 6667)
|
||||
("POLNet: Random server" POLNet "irc.ircnet.pl" 6667)
|
||||
("Psionics: CA, PQ, Montreal" Psionics "chat.psionics.net" ((6660 6669)))
|
||||
("PTirc: Random server" PTirc "irc.ptirc.com.pt" 6667)
|
||||
("PTlink: Random server" PTlink "irc.ptlink.net" 6667)
|
||||
("PTnet: Random server" PTnet "irc.ptnet.org" 6667)
|
||||
("QChat: Random server" QChat "irc.qchat.net" 6667)
|
||||
("QuakeNet: Random German server" QuakeNet "de.quakenet.org" ((6667 6669)))
|
||||
("QuakeNet: Random server" QuakeNet "irc.quakenet.eu.org" ((6667 6669)))
|
||||
("QuakeNet: Random Swedish server" QuakeNet "se.quakenet.org" ((6667 6669)))
|
||||
("QuakeNet: Random UK server" QuakeNet "uk.quakenet.org" ((6667 6669)))
|
||||
("QuakeNet: Random US server" QuakeNet "us.quakenet.org" ((6667 6669)))
|
||||
("Realirc: Random server" Realirc "irc.realirc.org" 6667)
|
||||
("RealmNET: Random server" RealmNET "irc.realmnet.com" 6667)
|
||||
("Rebelchat: Random server" Rebelchat "irc.rebelchat.org" 6667)
|
||||
("Red-Latina: Random server" Red-Latina "irc.red-latina.org" 6667)
|
||||
("RedLatona: Random server" RedLatona "irc.redlatona.net" (6667 6668 ))
|
||||
("Relicnet: Random server" Relicnet "irc.relic.net" 6667)
|
||||
("Rezosup: Random server" Rezosup "irc.rezosup.org" 6667)
|
||||
("Risanet: Random server" Risanet "irc.risanet.com" ((6667 6669)))
|
||||
("Rubiks: Random server" Rubiks "irc.rubiks.net" 6667)
|
||||
("Rusnet: EU, RU, Tomsk" Rusnet "irc.tsk.ru" ((6667 6669) (7770 7775) ))
|
||||
("Rusnet: EU, RU, Vladivostok" Rusnet "irc.vladivostok.ru" ((6667 6669) (7770 7775) ))
|
||||
("Rusnet: EU, UA, Kiev" Rusnet "irc.kar.net" ((6667 6669) (7770 7775) ))
|
||||
("Sandnet: Random server" Sandnet "irc.sandnet.net" ((6660 6669) 7000 ))
|
||||
("Scunc: Random server" Scunc "irc.scunc.net" 6667)
|
||||
("SerbianCafe: Random server" SerbianCafe "irc.serbiancafe.ws" ((6665 6669)))
|
||||
("SexNet: Random server" SexNet "irc.sexnet.org" 6667)
|
||||
("ShadowFire: Random server" ShadowFire "irc.shadowfire.org" 6667)
|
||||
("ShadowWorld: Random server" ShadowWorld "irc.shadowworld.net" 6667)
|
||||
("SkyNet: Random server" SkyNet "irc.bronowski.pl" ((6666 6668)))
|
||||
("Slashnet: Random server" Slashnet "irc.slashnet.org" 6667)
|
||||
("SolarStone: Random server" SolarStone "irc.solarstone.net" ((6660 6669)))
|
||||
("Sorcerynet: Random server" Sorcery "irc.sorcery.net" (6667 7000 9000 ))
|
||||
("Sorcerynet: EU, SE, Karlskrona" Sorcery "nexus.sorcery.net" (6667 7000 9000 ))
|
||||
("Sorcerynet: US, CA, Palo Alto" Sorcery "kechara.sorcery.net" (6667 7000 9000 ))
|
||||
("SourceIRC: Random server" SourceIRC "irc.sourceirc.net" ((6667 6669) 7000 ))
|
||||
("SpaceTronix: Random server" SpaceTronix "irc.spacetronix.net" ((6660 6669) 7000 ))
|
||||
("Spirit-Harmony: Random server" Spirit-Harmony "irc.spirit-harmony.com" ((6661 6669)))
|
||||
("StarChat: Random server" StarChat "irc.starchat.net" ((6667 6669) 7000 ))
|
||||
("StarEquinox: Random server" StarEquinox "irc.starequinox.net" ((6660 6669)))
|
||||
("StarLink: Random server" Starlink "irc.starlink.net" ((6660 6669)))
|
||||
("StarLink-irc: Random server" starlink-irc "irc.starlink-irc.org" 6667)
|
||||
("StarWars-IRC: Random server" StarWars-IRC "irc.starwars-irc.net" ((6663 6667)))
|
||||
("Stormdancing: Random server" Stormdancing "irc.stormdancing.net" ((6664 6669) 7000 9000 ))
|
||||
("Superchat: Random server" Superchat "irc.superchat.org" ((6660 6668)))
|
||||
("Sysopnet: Random server" Sysopnet "irc.sysopnet.org" ((6666 6668)))
|
||||
("Telstra: Random server" Telstra "irc.telstra.com" ((6667 6669)))
|
||||
("TR-net: EU, TR, Ankara" TR-net "irc.dominet.com.tr" 6667)
|
||||
("TR-net: EU, Tr, Istanbul" TR-net "irc.teklan.com.tr" 6667)
|
||||
("Tri-net: Random server" Tri-net "irc.tri-net.org" 6667)
|
||||
("TriLink: Random server" TriLink "irc.ft4u.net" 6667)
|
||||
("TurkishChat: Random server" TurkishChat "irc.turkishchat.org" ((6660 6669) 7000 ))
|
||||
("UberNinja: Random server" UberNinja "irc.uberninja.net" ((6667 6669)))
|
||||
("UICN: Random server" UICN "irc.uicn.net" 6667)
|
||||
("UltraIRC: Random server" UltraIRC "irc.ultrairc.net" 6667)
|
||||
("UnderChat: Random server" UnderChat "irc.underchat.it" ((6660 6669) 7000 ))
|
||||
("Undernet: CA, ON, Toronto" Undernet "toronto.on.ca.undernet.org" ((6661 6669)))
|
||||
("Undernet: CA, QC, Montreal" Undernet "montreal.qu.ca.undernet.org" ((6660 6669)))
|
||||
("Undernet: EU, AT, Graz" Undernet "graz.at.eu.undernet.org" ((6661 6669)))
|
||||
("Undernet: EU, BE, Antwerp" Undernet "flanders.be.eu.undernet.org" ((6660 6669)))
|
||||
("Undernet: EU, BE, Brussels" Undernet "brussels.be.eu.undernet.org" 6667)
|
||||
("Undernet: EU, CH, Geneva" Undernet "geneva.ch.eu.undernet.org" ((6660 6669) 7777 8000 ))
|
||||
("Undernet: EU, FR, Caen" Undernet "caen.fr.eu.undernet.org" ((6666 6669)))
|
||||
("Undernet: EU, NL, Diemen" Undernet "diemen.nl.eu.undernet.org" ((6660 6669)))
|
||||
("Undernet: EU, NL, Haarlem" Undernet "haarlem.nl.eu.undernet.org" ((6660 6669)))
|
||||
("Undernet: EU, NO, Oslo" Undernet "oslo.no.eu.undernet.org" ((6660 6669)))
|
||||
("Undernet: EU, SE, Stockholm" Undernet "stockholm.se.eu.undernet.org" ((6666 6669)))
|
||||
("Undernet: EU, UK, Surrey" Undernet "surrey.uk.eu.undernet.org" ((6660 6669)))
|
||||
("Undernet: US, AZ, Mesa" Undernet "mesa.az.us.undernet.org" ((6665 6667)))
|
||||
("Undernet: US, CA, San Diego" Undernet "sandiego.ca.us.undernet.org" ((6660 6670)))
|
||||
("Undernet: US, DC, Washington" Undernet "washington.dc.us.undernet.org" ((6660 6669)))
|
||||
("Undernet: US, KS, Manhattan" Undernet "manhattan.ks.us.undernet.org" ((6660 6669)))
|
||||
("Undernet: US, NV, Las Vegas" Undernet "lasvegas.nv.us.undernet.org" ((6660 6669)))
|
||||
("Undernet: US, TX, Austin" Undernet "austin.tx.us.undernet.org" ((6660 6669)))
|
||||
("Undernet: US, UT, Saltlake" Undernet "saltlake.ut.us.undernet.org" ((6660 6669)))
|
||||
("Undernet: US, VA, Arlington" Undernet "arlington.va.us.undernet.org" ((6660 6669)))
|
||||
("Undernet: US, VA, McLean" Undernet "mclean.va.us.undernet.org" ((6666 6669)))
|
||||
("Undernet: Random EU server" Undernet "eu.undernet.org" 6667)
|
||||
("Undernet: Random US server" Undernet "us.undernet.org" 6667)
|
||||
("UnderZ: Random server" UnderZ "irc.underz.org" ((6667 6668)))
|
||||
("UniChat: Random server" UniChat "irc.uni-chat.net" 6667)
|
||||
("UnionLatina: Random server" UnionLatina "irc.unionlatina.org" 6667)
|
||||
("Univers: Random server" Univers "irc.univers.org" ((6665 6669)))
|
||||
("UnixR: Random server" UnixR "irc.unixr.net" ((6667 6669)))
|
||||
("Vidgamechat: Random server" Vidgamechat "irc.vidgamechat.com" 6667)
|
||||
("VirtuaNet: Random server" VirtuaNet "irc.virtuanet.org" ((6660 6669) 7000 ))
|
||||
("Vitamina: Random server" Vitamina "irc.vitamina.ca" 6667)
|
||||
("Voila: Random server" Voila "irc.voila.fr" 6667)
|
||||
("Wahou: Random server" Wahou "irc.wahou.org" ((6665 6669)))
|
||||
("Warpednet: Random server" Warpednet "irc.warped.net" 6667)
|
||||
("Weaklinks: Random server" Weaklinks "irc.weaklinks.net" ((6667 6669)))
|
||||
("Webnet: Random server" Webnet "irc.webchat.org" ((6667 6669) 7000 ))
|
||||
("Webnet: US, CA, Santa Clara" Webnet "webmaster.ca.us.webchat.org" ((6661 6669)))
|
||||
("WinChat: Random server" WinChat "irc.winchat.net" ((6661 6669)))
|
||||
("WinIRC: Random server" WinIRC "irc.winirc.org" ((6667 6669) 4400 ))
|
||||
("WorldIRC: Random server" WorldIRC "irc.worldirc.org" ((6660 6667)))
|
||||
("WyldRyde: Random server" WyldRyde "irc.wyldryde.net" ((6666 6669)))
|
||||
("XentoniX: Random server" XentoniX "irc.xentonix.net" ((6661 6669)))
|
||||
("Xevion: Random server" Xevion "irc.xevion.net" (6667 7000 ))
|
||||
("XNet: Random server" XNet "irc.xnet.org" 6667)
|
||||
("XWorld: Random server" XWorld "irc.xworld.org" 6667)
|
||||
("ZAnet Net: Random server" ZAnetNet "irc.zanet.net" 6667)
|
||||
("ZAnet Org: UK, London" ZAnetOrg "mystic.zanet.org.za" 6667)
|
||||
("ZiRC: Random server" ZiRC "irc.zirc.org" ((6660 6669)))
|
||||
("ZUHnet: Random server" ZUHnet "irc.zuh.net" 6667)
|
||||
("Zurna: Random server" Zurna "irc.zurna.net" 6667))
|
||||
"Alist of irc servers. (NAME NET HOST PORTS) where
|
||||
NAME is a name for that server,
|
||||
NET is a symbol indicating to which network from `erc-networks-alist' this
|
||||
server corresponds,
|
||||
HOST is the servers hostname and
|
||||
PORTS is either a number, a list of numbers, or a list of port ranges."
|
||||
:group 'erc-networks
|
||||
:type 'sexp)
|
||||
|
||||
(defcustom erc-networks-alist
|
||||
'((4-irc "4-irc.com")
|
||||
(A5KNet "a5knet.com")
|
||||
(AbleNet "ablenet.org")
|
||||
(Accessirc "accessirc.net")
|
||||
(Acestar "acestar.org")
|
||||
(Action-IRC "action-irc.net")
|
||||
(AfterNET "afternet.org")
|
||||
(Alternativenet "altnet.org")
|
||||
(AmigaNet "amiganet.org")
|
||||
(AngelEyez "angeleyez.net")
|
||||
(Anothernet "another.net")
|
||||
(ArabChat "arabchat.org")
|
||||
(AsiaTalk "asiatalk.org")
|
||||
(AstroLink "astrolink.org")
|
||||
(Asylumnet "asylumnet.org")
|
||||
(Austnet "austnet.org")
|
||||
(AwesomeChat "awesomechat.net")
|
||||
(Awesomechristians "awesomechristians.com")
|
||||
(Axenet "axenet.org")
|
||||
(Beyondirc "beyondirc.net")
|
||||
(BGIRC "bulgaria.org")
|
||||
(Blabbernet "blabber.net")
|
||||
(Blitzed "blitzed.org")
|
||||
(BrasIRC "brasirc.net")
|
||||
(BRASnet "brasnet.org")
|
||||
(BubbleNet "bubblenet.org")
|
||||
(CCnet "christian-chat.net")
|
||||
(Chat-Net "chat-net.org")
|
||||
(Chat-Solutions "chat-solutions.org")
|
||||
(Chatcafe "chatcafe.net")
|
||||
(Chatchannel "chatchannel.org")
|
||||
(ChatCircuit "chatcircuit.com")
|
||||
(Chatlink "chatlink.org")
|
||||
(Chatnet "chatnet.org")
|
||||
(ChatNut "chatnut.net")
|
||||
(Chatpinoy "chatpinoy.com")
|
||||
(ChatPR "chatpr.org")
|
||||
(Chatroom "chatroom.org")
|
||||
(Chatster "chatster.org")
|
||||
(ChatX "chatx.net")
|
||||
(China263 "263.net")
|
||||
(Cineplex1 "cineplex1.com")
|
||||
(CNN "cnn.com")
|
||||
(CobraNet "cobra.net")
|
||||
(Coolchat "coolchat.net")
|
||||
(Criten "criten.net")
|
||||
(Cyberchat "cyberchat.org")
|
||||
(CyGanet "cyga.net")
|
||||
(DALnet "dal.net")
|
||||
(Dark-Tou-Net "d-t-net.de")
|
||||
(Darkfire "darkfire.net")
|
||||
(DarkMyst "darkmyst.org")
|
||||
(Darkserv "darkserv.net")
|
||||
(Darksystem "darksystem.com")
|
||||
(Darktree "darktree.net")
|
||||
(DayNet "daynet.org")
|
||||
(Deepspace "deepspace.org")
|
||||
(Different "different.net")
|
||||
(Digarix "digarix.net")
|
||||
(Digatech "digatech.net")
|
||||
(Digital-Base "digital-base.net")
|
||||
(Digitalirc "digitalirc.net")
|
||||
(Discussioni "discussioni.org")
|
||||
(DorukNet "doruk.net.tr")
|
||||
(DWChat "dwchat.net")
|
||||
(Dynastynet "dynastynet.net")
|
||||
(EFnet nil)
|
||||
(EgyptianIRC "egyptianirc.net")
|
||||
(Eircnet "eircnet.org")
|
||||
(Eleethal "eleethal.com")
|
||||
(EntertheGame "enterthegame.com")
|
||||
(EpiKnet "epiknet.org")
|
||||
(EsperNet "esper.net")
|
||||
(Esprit "esprit.net")
|
||||
(euIRC "euirc.net")
|
||||
(Evilzinc "evilzinc.net")
|
||||
(ExodusIRC "exodusirc.net")
|
||||
(FDFnet "fdfnet.net")
|
||||
(FEFnet "fef.net")
|
||||
(Financialchat "financialchat.com")
|
||||
(Forestnet "forestnet.org")
|
||||
(ForeverChat "foreverchat.net")
|
||||
(Fraggers "fraggers.co.uk")
|
||||
(FreedomChat "freedomchat.net")
|
||||
(FreedomIRC "freedomirc.net")
|
||||
(freenode "freenode.net")
|
||||
(FunNet "funnet.org")
|
||||
(GalaxyNet "galaxynet.org")
|
||||
(Gamesnet "gamesnet.net")
|
||||
(GammaForce "gammaforce.org")
|
||||
(GIKInet "giki.edu.pk")
|
||||
(GizNet "giznet.org")
|
||||
(Globalchat "globalchat.org")
|
||||
(GlobIRC "globirc.net")
|
||||
(Goldchat "goldchat.nl")
|
||||
(Goodchatting "goodchatting.com")
|
||||
(GravityLords "gravitylords.net")
|
||||
(GRnet "irc.gr")
|
||||
(GulfChat "gulfchat.net")
|
||||
(HabberNet "habber.net")
|
||||
(HanIRC "hanirc.org")
|
||||
(Hellenicnet "mirc.gr")
|
||||
(IceNet "icenet.org.za")
|
||||
(ICQnet "icq.com")
|
||||
(iip "anon.iip")
|
||||
(Infatech "infatech.net")
|
||||
(Infinity "infinity-irc.org")
|
||||
(Infomatrix "infomatrix.net")
|
||||
(Inside3D "inside3d.net")
|
||||
(InterlinkChat "interlinkchat.net")
|
||||
(IRC-Chile "irc.cl")
|
||||
(IRC-Hispano "irc-hispano.org")
|
||||
(IRCchat "ircchat.tk")
|
||||
(IRCGate "ircgate.net")
|
||||
(IRCGeeks "ircgeeks.org")
|
||||
(IRChat "irchat.net")
|
||||
(IrcLordz "irclordz.com")
|
||||
(IrcMalta "ircmalta.org")
|
||||
(IRCnet nil)
|
||||
(IRCSoulZ "ircsoulz.net")
|
||||
(IRCSul "wnet.com.br")
|
||||
(IrcTalk "irctalk.net")
|
||||
(Irctoo "irctoo.net")
|
||||
(IRCtown "irc.irctown.net")
|
||||
(IRCworld "ircworld.org")
|
||||
(ircXtreme "ircXtreme.net")
|
||||
(Israelnet "israel.net")
|
||||
(K0wNet "k0w.net")
|
||||
(KDFSnet "kdfs.net")
|
||||
(Kemik "kemik.net")
|
||||
(Kewl\.Org "kewl.org")
|
||||
(Kickchat "kickchat.com")
|
||||
(KidsWorld "kidsworld.org")
|
||||
(Knightnet "knightnet.net")
|
||||
(Konfido\.Net "konfido.net")
|
||||
(Kreynet "krey.net")
|
||||
(Krono "krono.net")
|
||||
(Krushnet "krushnet.org")
|
||||
(LagNet "lagnet.org.za")
|
||||
(Librenet "librenet.net")
|
||||
(LinkNet "link-net.org")
|
||||
(Liquidized "liquidized.net")
|
||||
(M-IRC "m-sys.org")
|
||||
(MagicStar "magicstar.net")
|
||||
(Mavra "mavra.net")
|
||||
(MediaDriven "mediadriven.com")
|
||||
(mIRC-X "mircx.com")
|
||||
(Morat "morat.net")
|
||||
(MusicCity "musiccity.com")
|
||||
(Mysteria "mysteria.net")
|
||||
(Mysterychat "mysterychat.net")
|
||||
(Mystical "mystical.net")
|
||||
(Narancs "narancs.com")
|
||||
(Net-France "net-france.com")
|
||||
(Nevernet "nevernet.net")
|
||||
(Newnet "newnet.net")
|
||||
(Nexusirc "nexusirc.org")
|
||||
(NightStar "nightstar.net")
|
||||
(NitrousNet "nitrousnet.net")
|
||||
(Novernet "novernet.com")
|
||||
(Nullrouted "nullrouted.org")
|
||||
(NullusNet "nullus.net")
|
||||
(OpChat "opchat.org")
|
||||
(Openprojects "openprojects.net")
|
||||
(Othernet "othernet.org")
|
||||
(OtherSide "othersideirc.net")
|
||||
(Outsiderz "outsiderz.com")
|
||||
(OzOrg "oz.org")
|
||||
(Peacefulhaven "peacefulhaven.net")
|
||||
(PhazedIRC "phazedirc.net")
|
||||
(Philchat "philchat.net")
|
||||
(phrozN "phrozn.net")
|
||||
(PiNet "praetorians.org")
|
||||
(Pinoycentral "abs-cbn.com")
|
||||
(Planetarion "planetarion.com")
|
||||
(POLNet "ircnet.pl")
|
||||
(Psionics "psionics.net")
|
||||
(PTirc "ptirc.com.pt")
|
||||
(PTlink "ptlink.net")
|
||||
(PTnet "ptnet.org")
|
||||
(QChat "qchat.net")
|
||||
(QuakeNet "quakenet.org")
|
||||
(Realirc "realirc.org")
|
||||
(RealmNET "realmnet.com")
|
||||
(Rebelchat "rebelchat.org")
|
||||
(Red-Latina "red-latina.org")
|
||||
(RedLatona "redlatona.net")
|
||||
(Relicnet "relic.net")
|
||||
(Rezosup "rezosup.org")
|
||||
(Risanet "risanet.com")
|
||||
(Rubiks "rubiks.net")
|
||||
(Rusnet "nil")
|
||||
(Sandnet "sandnet.net")
|
||||
(Scunc "scunc.net")
|
||||
(SerbianCafe "serbiancafe.ws")
|
||||
(SexNet "sexnet.org")
|
||||
(ShadowFire "shadowfire.org")
|
||||
(ShadowWorld "shadowworld.net")
|
||||
(SkyNet "bronowski.pl")
|
||||
(SlashNET "slashnet.org")
|
||||
(SolarStone "solarstone.net")
|
||||
(Sorcery "sorcery.net")
|
||||
(SourceIRC "sourceirc.net")
|
||||
(SpaceTronix "spacetronix.net")
|
||||
(Spirit-Harmony "spirit-harmony.com")
|
||||
(StarChat "starchat.net")
|
||||
(StarEquinox "starequinox.net")
|
||||
(Starlink "starlink.net")
|
||||
(starlink-irc "starlink-irc.org")
|
||||
(StarWars-IRC "starwars-irc.net")
|
||||
(Stormdancing "stormdancing.net")
|
||||
(Superchat "superchat.org")
|
||||
(Sysopnet "sysopnet.org")
|
||||
(Telstra "telstra.com")
|
||||
(TR-net "dominet.com.tr")
|
||||
(Tri-net "tri-net.org")
|
||||
(TriLink "ft4u.net")
|
||||
(TurkishChat "turkishchat.org")
|
||||
(UberNinja "uberninja.net")
|
||||
(UICN "uicn.net")
|
||||
(UltraIRC "ultrairc.net")
|
||||
(UnderChat "underchat.it")
|
||||
(Undernet "undernet.org")
|
||||
(UnderZ "underz.org")
|
||||
(UniChat "irc.uni-chat.net")
|
||||
(UnionLatina "unionlatina.org")
|
||||
(Univers "univers.org")
|
||||
(UnixR "unixr.net")
|
||||
(Vidgamechat "vidgamechat.com")
|
||||
(VirtuaNet "virtuanet.org")
|
||||
(Vitamina "vitamina.ca")
|
||||
(Voila "voila.fr")
|
||||
(Wahou "wf-net.org")
|
||||
(Warpednet "warped.net")
|
||||
(Weaklinks "weaklinks.net")
|
||||
(Webnet "webchat.org")
|
||||
(WinChat "winchat.net")
|
||||
(WinIRC "winirc.org")
|
||||
(WorldIRC "worldirc.org")
|
||||
(WyldRyde "wyldryde.net")
|
||||
(XentoniX "xentonix.net")
|
||||
(Xevion "xevion.net")
|
||||
(XNet "xnet.org")
|
||||
(XWorld "xworld.org")
|
||||
(ZAnetNet "zanet.net")
|
||||
(ZAnetOrg "zanet.org.za")
|
||||
(ZiRC "zirc.org")
|
||||
(ZUHnet "zuh.net")
|
||||
(Zurna "zurna.net"))
|
||||
"Alist of IRC networks. (NET MATCHER) where
|
||||
NET is a symbol naming that IRC network and
|
||||
MATCHER is used to find a corresponding network to a server while connected to
|
||||
it. If it is regexp, it's used to match against `erc-server-announced-name'.
|
||||
It can also be a function (predicate). Then it is executed with the
|
||||
server buffer as current-buffer."
|
||||
:group 'erc-networks
|
||||
:type '(repeat
|
||||
(list :tag "Network"
|
||||
(symbol :tag "Network name")
|
||||
(choice :tag "Network's common server ending"
|
||||
(regexp)
|
||||
(const :tag "Network has no common server ending" nil)))))
|
||||
|
||||
(defvar erc-network nil
|
||||
"The name of the network you are connected to (a symbol).")
|
||||
(make-variable-buffer-local 'erc-network)
|
||||
|
||||
;; Functions:
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-determine-network ()
|
||||
"Return the name of the network or \"Unknown\" as a symbol. Use the
|
||||
server parameter NETWORK if provided, otherwise parse the server name and
|
||||
search for a match in `erc-networks-alist'."
|
||||
;; The server made it easy for us and told us the name of the NETWORK
|
||||
(if (assoc "NETWORK" erc-server-parameters)
|
||||
(intern (cdr (assoc "NETWORK" erc-server-parameters)))
|
||||
(or
|
||||
;; Loop through `erc-networks-alist' looking for a match.
|
||||
(let ((server (or erc-server-announced-name erc-session-server)))
|
||||
(loop for (name matcher) in erc-networks-alist
|
||||
when (and matcher
|
||||
(string-match (concat matcher "\\'") server))
|
||||
do (return name)))
|
||||
'Unknown)))
|
||||
|
||||
(defun erc-network ()
|
||||
"Return the value of `erc-network' for the current server."
|
||||
(with-current-buffer (erc-server-buffer) erc-network))
|
||||
|
||||
(defun erc-current-network ()
|
||||
"Deprecated. Use `erc-network' instead. Return the name of this server's
|
||||
network as a symbol."
|
||||
(with-current-buffer (erc-server-buffer)
|
||||
(intern (downcase (symbol-name erc-network)))))
|
||||
|
||||
(erc-make-obsolete 'erc-current-network 'erc-network
|
||||
"Obsolete since erc-nets 1.5")
|
||||
|
||||
(defun erc-network-name ()
|
||||
"Returns the name of the current network as a string."
|
||||
(with-current-buffer (erc-server-buffer) (symbol-name erc-network)))
|
||||
|
||||
(defun erc-set-network-name (proc parsed)
|
||||
"Set `erc-network' to the value returned by `erc-determine-network'."
|
||||
(unless erc-server-connected
|
||||
(setq erc-network (erc-determine-network)))
|
||||
nil)
|
||||
|
||||
(defun erc-unset-network-name (nick ip reason)
|
||||
"Set `erc-network' to nil."
|
||||
(setq erc-network nil)
|
||||
nil)
|
||||
|
||||
(add-hook 'erc-server-375-functions 'erc-set-network-name)
|
||||
(add-hook 'erc-server-422-functions 'erc-set-network-name)
|
||||
(add-hook 'erc-disconnected-hook 'erc-unset-network-name)
|
||||
|
||||
(defun erc-ports-list (ports)
|
||||
"Return a list of PORTS.
|
||||
|
||||
PORTS should be a list of either:
|
||||
A number, in which case it is returned a list.
|
||||
Or a pair of the form (LOW HIGH), in which case, a list of all the
|
||||
numbers between LOW and HIGH (inclusive) is returned.
|
||||
|
||||
As an example:
|
||||
(erc-ports-list '(1)) => (1)
|
||||
(erc-ports-list '((1 5))) => (1 2 3 4 5)
|
||||
(erc-ports-list '(1 (3 5))) => (1 3 4 5)"
|
||||
(let (result)
|
||||
(dolist (p ports)
|
||||
(cond ((numberp p)
|
||||
(push p result))
|
||||
((listp p)
|
||||
(setq result (nconc (loop for i from (cadr p) downto (car p)
|
||||
collect i)
|
||||
result)))))
|
||||
(nreverse result)))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-server-select ()
|
||||
"Interactively select a server to connect to using `erc-server-alist'."
|
||||
(interactive)
|
||||
(let* ((completion-ignore-case t)
|
||||
(net (intern
|
||||
(completing-read "Network: "
|
||||
(erc-delete-dups
|
||||
(mapcar (lambda (x)
|
||||
(list (symbol-name (nth 1 x))))
|
||||
erc-server-alist)))))
|
||||
(srv (assoc
|
||||
(completing-read "Server: "
|
||||
(delq nil
|
||||
(mapcar (lambda (x)
|
||||
(when (equal (nth 1 x) net)
|
||||
x))
|
||||
erc-server-alist)))
|
||||
erc-server-alist))
|
||||
(host (nth 2 srv))
|
||||
(ports (if (listp (nth 3 srv))
|
||||
(erc-ports-list (nth 3 srv))
|
||||
(list (nth 3 srv))))
|
||||
(port (nth (random (length ports)) ports)))
|
||||
(erc host port erc-nick erc-user-full-name t)))
|
||||
|
||||
;;; The following experimental
|
||||
;; It does not work yet, help me with it if you
|
||||
;; think it is worth the effort.
|
||||
|
||||
(defvar erc-settings
|
||||
'((pals freenode ("kensanata" "shapr" "anti\\(fuchs\\|gone\\)"))
|
||||
(format-nick-function (freenode "#emacs") erc-format-@nick))
|
||||
"Experimental: Alist of configuration options.
|
||||
The format is (VARNAME SCOPE VALUE) where
|
||||
VARNAME is a symbol identifying the configuration option,
|
||||
SCOPE is either a symbol which identifies an entry from
|
||||
`erc-networks-alist' or a list (NET TARGET) where NET is a network symbol and
|
||||
TARGET is a string identifying the channel/query target.
|
||||
VALUE is the options value.")
|
||||
|
||||
(defun erc-get (var &optional net target)
|
||||
(let ((items erc-settings)
|
||||
elt val)
|
||||
(while items
|
||||
(setq elt (car items)
|
||||
items (cdr items))
|
||||
(when (eq (car elt) var)
|
||||
(cond ((and net target (listp (nth 1 elt))
|
||||
(eq net (car (nth 1 elt)))
|
||||
(string-equal target (nth 1 (nth 1 elt))))
|
||||
(setq val (nth 2 elt)
|
||||
items nil))
|
||||
((and net (eq net (nth 1 elt)))
|
||||
(setq val (nth 2 elt)
|
||||
items nil))
|
||||
((and (not net) (not target) (not (nth 1 elt)))
|
||||
(setq val (nth 2 elt)
|
||||
items nil)))))
|
||||
val))
|
||||
|
||||
(erc-get 'pals 'freenode)
|
||||
|
||||
|
||||
(provide 'erc-nets)
|
||||
|
||||
;;; erc-nets.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 68cccabd-f66b-456c-9abe-5f993a2dc91c
|
||||
212
lisp/erc/erc-netsplit.el
Normal file
212
lisp/erc/erc-netsplit.el
Normal file
|
|
@ -0,0 +1,212 @@
|
|||
;;; erc-netsplit.el --- Reduce JOIN/QUIT messages on netsplits
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
;; Keywords: comm
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This module hides quit/join messages if a netsplit occurs.
|
||||
;; To enable, add the following to your ~/.emacs:
|
||||
;; (require 'erc-netsplit)
|
||||
;; (erc-netsplit-mode 1)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup erc-netsplit nil
|
||||
"Netsplit detection tries to automatically figure when a
|
||||
netsplit happens, and filters the QUIT messages. It also keeps
|
||||
track of netsplits, so that it can filter the JOIN messages on a netjoin too."
|
||||
:group 'erc)
|
||||
|
||||
;;;###autoload (autoload 'erc-netsplit-mode "erc-netsplit")
|
||||
(define-erc-module netsplit nil
|
||||
"This mode hides quit/join messages if a netsplit occurs."
|
||||
((erc-netsplit-install-message-catalogs)
|
||||
(add-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN)
|
||||
(add-hook 'erc-server-MODE-functions 'erc-netsplit-MODE)
|
||||
(add-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT)
|
||||
(add-hook 'erc-timer-hook 'erc-netsplit-timer))
|
||||
((remove-hook 'erc-server-JOIN-functions 'erc-netsplit-JOIN)
|
||||
(remove-hook 'erc-server-MODE-functions 'erc-netsplit-MODE)
|
||||
(remove-hook 'erc-server-QUIT-functions 'erc-netsplit-QUIT)
|
||||
(remove-hook 'erc-timer-hook 'erc-netsplit-timer)))
|
||||
|
||||
(defcustom erc-netsplit-show-server-mode-changes-flag nil
|
||||
"Set to t to enable display of server mode changes."
|
||||
:group 'erc-netsplit
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-netsplit-debug nil
|
||||
"If non-nil, debug messages will be shown in the
|
||||
sever buffer."
|
||||
:group 'erc-netsplit
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-netsplit-regexp "^[^ @!\"]+\\.[^ @!]+ [^ @!]+\\.[^ @!\"]+$"
|
||||
"This regular expression should match quit reasons produced
|
||||
by netsplits."
|
||||
:group 'erc-netsplit
|
||||
:type 'regexp)
|
||||
|
||||
(defcustom erc-netsplit-hook nil
|
||||
"Run whenever a netsplit is detected the first time.
|
||||
Args: PROC is the process the netsplit originated from and
|
||||
SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")."
|
||||
:group 'erc-hooks
|
||||
:type 'hook)
|
||||
|
||||
(defcustom erc-netjoin-hook nil
|
||||
"Run whenever a netjoin is detected the first time.
|
||||
Args: PROC is the process the netjoin originated from and
|
||||
SPLIT is the netsplit (e.g. \"server.name.1 server.name.2\")."
|
||||
:group 'erc-hooks
|
||||
:type 'hook)
|
||||
|
||||
(defvar erc-netsplit-list nil
|
||||
"This is a list of the form
|
||||
\((\"a.b.c.d e.f.g\" TIMESTAMP 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.")
|
||||
(make-variable-buffer-local 'erc-netsplit-list)
|
||||
|
||||
(defun erc-netsplit-install-message-catalogs ()
|
||||
(erc-define-catalog
|
||||
'english
|
||||
'((netsplit . "netsplit: %s")
|
||||
(netjoin . "netjoin: %s, %N were split")
|
||||
(netjoin-done . "netjoin: All lost souls are back!")
|
||||
(netsplit-none . "No netsplits in progress")
|
||||
(netsplit-wholeft . "split: %s missing: %n %t"))))
|
||||
|
||||
(defun erc-netsplit-JOIN (proc parsed)
|
||||
"Show/don't show rejoins."
|
||||
(let ((nick (erc-response.sender parsed))
|
||||
(no-next-hook nil))
|
||||
(dolist (elt erc-netsplit-list)
|
||||
(if (member nick (nthcdr 3 elt))
|
||||
(progn
|
||||
(if (not (caddr elt))
|
||||
(progn
|
||||
(erc-display-message
|
||||
parsed 'notice (process-buffer proc)
|
||||
'netjoin ?s (car elt) ?N (length (nthcdr 3 elt)))
|
||||
(setcar (nthcdr 2 elt) t)
|
||||
(run-hook-with-args 'erc-netjoin-hook proc (car elt))))
|
||||
;; 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))
|
||||
(progn
|
||||
(erc-display-message
|
||||
parsed 'notice (process-buffer proc)
|
||||
'netjoin-done ?s (car elt))
|
||||
(setq erc-netsplit-list (delq elt erc-netsplit-list)))
|
||||
(delete nick elt))
|
||||
(setq no-next-hook t))))
|
||||
no-next-hook))
|
||||
|
||||
(defun erc-netsplit-MODE (proc parsed)
|
||||
"Hide mode changes from servers."
|
||||
;; regexp matches things with a . in them, and no ! or @ in them.
|
||||
(when (string-match "^[^@!]+\\.[^@!]+$" (erc-response.sender parsed))
|
||||
(and erc-netsplit-debug
|
||||
(erc-display-message
|
||||
parsed 'notice (process-buffer proc)
|
||||
"[debug] server mode change."))
|
||||
(not erc-netsplit-show-server-mode-changes-flag)))
|
||||
|
||||
(defun erc-netsplit-QUIT (proc parsed)
|
||||
"Detect netsplits."
|
||||
(let ((split (erc-response.contents parsed))
|
||||
(nick (erc-response.sender parsed))
|
||||
ass)
|
||||
(when (string-match erc-netsplit-regexp split)
|
||||
(setq ass (assoc split erc-netsplit-list))
|
||||
(if ass
|
||||
;; element for this netsplit exists already
|
||||
(progn
|
||||
(setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass)))
|
||||
(when (caddr ass)
|
||||
;; There was already a netjoin for this netsplit, it
|
||||
;; seems like the old one didn't get finished...
|
||||
(erc-display-message
|
||||
parsed 'notice (process-buffer proc)
|
||||
'netsplit ?s split)
|
||||
(setcar (nthcdr 2 ass) t)
|
||||
(run-hook-with-args 'erc-netsplit-hook proc split)))
|
||||
;; element for this netsplit does not yet exist
|
||||
(setq erc-netsplit-list
|
||||
(cons (list split
|
||||
(erc-current-time)
|
||||
nil
|
||||
nick)
|
||||
erc-netsplit-list))
|
||||
(erc-display-message
|
||||
parsed 'notice (process-buffer proc)
|
||||
'netsplit ?s split)
|
||||
(run-hook-with-args 'erc-netsplit-hook proc split))
|
||||
t)))
|
||||
|
||||
(defun erc-netsplit-timer (now)
|
||||
"Clean cruft from `erc-netsplit-list' older than 10 minutes."
|
||||
(dolist (elt erc-netsplit-list)
|
||||
(when (> (erc-time-diff (cadr elt) now) 600)
|
||||
(when erc-netsplit-debug
|
||||
(erc-display-message
|
||||
nil 'notice (current-buffer)
|
||||
(concat "Netsplit: Removing " (car elt))))
|
||||
(setq erc-netsplit-list (delq elt erc-netsplit-list)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-cmd-WHOLEFT ()
|
||||
"Show who's gone."
|
||||
(with-current-buffer (erc-server-buffer)
|
||||
(if (null erc-netsplit-list)
|
||||
(erc-display-message
|
||||
nil 'notice 'active
|
||||
'netsplit-none)
|
||||
(dolist (elt erc-netsplit-list)
|
||||
(erc-display-message
|
||||
nil 'notice 'active
|
||||
'netsplit-wholeft ?s (car elt)
|
||||
?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ")
|
||||
?t (if (caddr elt)
|
||||
"(joining)"
|
||||
"")))))
|
||||
t)
|
||||
|
||||
(defalias 'erc-cmd-WL 'erc-cmd-WHOLEFT)
|
||||
|
||||
(provide 'erc-netsplit)
|
||||
|
||||
;;; erc-netsplit.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 61a85cb0-7e7b-4312-a4f6-313c7a25a6e8
|
||||
411
lisp/erc/erc-nicklist.el
Normal file
411
lisp/erc/erc-nicklist.el
Normal file
|
|
@ -0,0 +1,411 @@
|
|||
;;; erc-nicklist.el --- Display channel nicknames in a side buffer.
|
||||
|
||||
;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Filename: erc-nicklist.el
|
||||
;; Author: Lawrence Mitchell <wence@gmx.li>
|
||||
;; Created: 2004-04-30
|
||||
;; Keywords: IRC chat client Internet
|
||||
|
||||
;; 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:
|
||||
;;
|
||||
;; This provides a minimal mIRC style nicklist buffer for ERC. To
|
||||
;; activate, do M-x erc-nicklist RET in the channel buffer you want
|
||||
;; the nicklist to appear for. To close and quit the nicklist
|
||||
;; buffer, do M-x erc-nicklist-quit RET.
|
||||
;;
|
||||
;; TODO:
|
||||
;; o Somehow associate nicklist windows with channel windows so they
|
||||
;; appear together, and if one gets buried, then the other does.
|
||||
;;
|
||||
;; o Make "Query" and "Message" work.
|
||||
;;
|
||||
;; o Prettify the actual list of nicks in some way.
|
||||
;;
|
||||
;; o Add a proper erc-module that people can turn on and off, figure
|
||||
;; out a way of creating the nicklist window at an appropriate time
|
||||
;; --- probably in `erc-join-hook'.
|
||||
;;
|
||||
;; o Ensure XEmacs compatibility --- the mouse-menu support is likely
|
||||
;; broken.
|
||||
;;
|
||||
;; o Add option to display in a separate frame --- will again need to
|
||||
;; be able to associate the nicklist with the currently active
|
||||
;; channel buffer or something similar.
|
||||
;;
|
||||
;; o Allow toggling of visibility of nicklist via ERC commands.
|
||||
|
||||
;;; History:
|
||||
;;
|
||||
|
||||
;; Changes by Edgar Gonçalves <edgar.goncalves@inesc-id.pt>
|
||||
;; Jun 25 2005:
|
||||
;; - images are changed to a standard set of names.
|
||||
;; - /images now contain gaim's status icons.
|
||||
;; May 31 2005:
|
||||
;; - tooltips are improved. they try to access bbdb for a nice nick!
|
||||
;; Apr 26 2005:
|
||||
;; - erc-nicklist-channel-users-info was fixed (sorting bug)
|
||||
;; - Away names don't need parenthesis when using icons
|
||||
;; Apr 26 2005:
|
||||
;; - nicks can display icons of their connection type (msn, icq, for now)
|
||||
;; Mar 15 2005:
|
||||
;; - nicks now are different for unvoiced and op users
|
||||
;; - nicks now have tooltips displaying more info
|
||||
;; Mar 18 2005:
|
||||
;; - queries now work ok, both on menu and keyb shortcut RET.
|
||||
;; - nicklist is now sorted ignoring the case. Voiced nicks will
|
||||
;; appear according to `erc-nicklist-voiced-position'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(condition-case nil
|
||||
(require 'erc-bbdb)
|
||||
(error nil))
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup erc-nicklist nil
|
||||
"Display a list of nicknames in a separate window."
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-nicklist-use-icons t
|
||||
"*If non-nil, display an icon instead of the name of the chat medium.
|
||||
By \"chat medium\", we mean IRC, AOL, MSN, ICQ, etc."
|
||||
:group 'erc-nicklist
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-nicklist-icons-directory
|
||||
(concat default-directory "images/")
|
||||
"*Directory of the PNG files for chat icons.
|
||||
Icons are displayed if `erc-nicklist-use-icons' is non-nil."
|
||||
:group 'erc-nicklist
|
||||
:type 'string)
|
||||
|
||||
(defcustom erc-nicklist-voiced-position 'bottom
|
||||
"*Position of voiced nicks in the nicklist.
|
||||
The value can be `top', `bottom' or nil (don't sort)."
|
||||
:group 'erc-nicklist
|
||||
:type '(choice
|
||||
(const :tag "Top" 'top)
|
||||
(const :tag "Bottom" 'bottom)
|
||||
(const :tag "Mixed" nil)))
|
||||
|
||||
(defcustom erc-nicklist-window-size 20.0
|
||||
"*The size of the nicklist window.
|
||||
|
||||
This specifies a percentage of the channel window width.
|
||||
|
||||
A negative value means the nicklist window appears on the left of the
|
||||
channel window, and vice versa."
|
||||
:group 'erc-nicklist
|
||||
:type 'float)
|
||||
|
||||
|
||||
(defun erc-nicklist-buffer-name (&optional buffer)
|
||||
"Return the buffer name for a nicklist associated with BUFFER.
|
||||
|
||||
If BUFFER is nil, use the value of `current-buffer'."
|
||||
(format " *%s-nicklist*" (buffer-name (or buffer (current-buffer)))))
|
||||
|
||||
(defun erc-nicklist-make-window ()
|
||||
"Create an ERC nicklist window.
|
||||
|
||||
See also `erc-nicklist-window-size'."
|
||||
(let ((width (floor (* (window-width) (/ erc-nicklist-window-size 100.0))))
|
||||
(buffer (erc-nicklist-buffer-name))
|
||||
window)
|
||||
(split-window-horizontally (- width))
|
||||
(setq window (next-window))
|
||||
(set-window-buffer window (get-buffer-create buffer))
|
||||
(with-current-buffer buffer
|
||||
(set-window-dedicated-p window t))))
|
||||
|
||||
|
||||
(defvar erc-nicklist-images-alist '()
|
||||
"Alist that maps a connection type to an icon.")
|
||||
|
||||
(defun erc-nicklist-insert-medium-name-or-icon (host channel is-away)
|
||||
"Inserts an icon or a string identifying the current host type.
|
||||
This is configured using `erc-nicklist-use-icons' and
|
||||
`erc-nicklist-icons-directory'."
|
||||
;; identify the network (for bitlebee usage):
|
||||
(let ((bitlbee-p (save-match-data
|
||||
(string-match "\\`&bitlbee\\b"
|
||||
(buffer-name channel)))))
|
||||
(cond ((and bitlbee-p
|
||||
(string= "login.icq.com" host))
|
||||
(if erc-nicklist-use-icons
|
||||
(if is-away
|
||||
(insert-image (cdr (assoc 'icq-away
|
||||
erc-nicklist-images-alist)))
|
||||
(insert-image (cdr (assoc 'icq
|
||||
erc-nicklist-images-alist))))
|
||||
(insert "ICQ")))
|
||||
(bitlbee-p
|
||||
(if erc-nicklist-use-icons
|
||||
(if is-away
|
||||
(insert-image (cdr (assoc 'msn-away
|
||||
erc-nicklist-images-alist)))
|
||||
(insert-image (cdr (assoc 'msn
|
||||
erc-nicklist-images-alist))))
|
||||
(insert "MSN")))
|
||||
(t
|
||||
(if erc-nicklist-use-icons
|
||||
(if is-away
|
||||
(insert-image (cdr (assoc 'irc-away
|
||||
erc-nicklist-images-alist)))
|
||||
(insert-image (cdr (assoc 'irc
|
||||
erc-nicklist-images-alist))))
|
||||
(insert "IRC"))))
|
||||
(insert " ")))
|
||||
|
||||
(defun erc-nicklist-search-for-nick (finger-host)
|
||||
"Return the bitlbee-nick field for this contact given FINGER-HOST.
|
||||
Seach for the BBDB record of this contact. If not found, return nil."
|
||||
(when (boundp 'erc-bbdb-bitlbee-name-field)
|
||||
(let ((record (car
|
||||
(erc-member-if
|
||||
#'(lambda (r)
|
||||
(let ((fingers (bbdb-record-finger-host r)))
|
||||
(when fingers
|
||||
(string-match finger-host
|
||||
(car (bbdb-record-finger-host r))))))
|
||||
(bbdb-records)))))
|
||||
(when record
|
||||
(bbdb-get-field record erc-bbdb-bitlbee-name-field)))))
|
||||
|
||||
(defun erc-nicklist-insert-contents (channel)
|
||||
"Insert the nicklist contents, with text properties and the optional images."
|
||||
(setq buffer-read-only nil)
|
||||
(erase-buffer)
|
||||
(dolist (u (erc-nicklist-channel-users-info channel))
|
||||
(let* ((server-user (car u))
|
||||
(channel-user (cdr u))
|
||||
(nick (erc-server-user-nickname server-user))
|
||||
(host (erc-server-user-host server-user))
|
||||
(login (erc-server-user-login server-user))
|
||||
(full-name(erc-server-user-full-name server-user))
|
||||
(info (erc-server-user-info server-user))
|
||||
(channels (erc-server-user-buffers server-user))
|
||||
(op (erc-channel-user-op channel-user))
|
||||
(voice (erc-channel-user-voice channel-user))
|
||||
(bbdb-nick (erc-nicklist-search-for-nick (concat login "@" host)))
|
||||
(away-status (if voice "" "\n(Away)"))
|
||||
(balloon-text (concat bbdb-nick (if (string= "" bbdb-nick)
|
||||
"" "\n")
|
||||
"Login: " login "@" host
|
||||
away-status)))
|
||||
(erc-nicklist-insert-medium-name-or-icon host channel (not voice))
|
||||
(unless (or voice erc-nicklist-use-icons)
|
||||
(setq nick (concat "(" nick ")")))
|
||||
(when op
|
||||
(setq nick (concat nick " (OP)")))
|
||||
(insert (erc-propertize nick
|
||||
'erc-nicklist-nick nick
|
||||
'mouse-face 'highlight
|
||||
'erc-nicklist-channel channel
|
||||
'help-echo balloon-text)
|
||||
"\n")))
|
||||
(erc-nicklist-mode))
|
||||
|
||||
|
||||
(defun erc-nicklist ()
|
||||
"Create an ERC nicklist buffer."
|
||||
(interactive)
|
||||
(let ((channel (current-buffer)))
|
||||
(unless (or (not erc-nicklist-use-icons)
|
||||
erc-nicklist-images-alist)
|
||||
(setq erc-nicklist-images-alist
|
||||
`((msn . ,(create-image (concat erc-nicklist-icons-directory
|
||||
"msn-online.png")))
|
||||
(msn-away . ,(create-image (concat erc-nicklist-icons-directory
|
||||
"msn-offline.png")))
|
||||
(irc . ,(create-image (concat erc-nicklist-icons-directory
|
||||
"irc-online.png")))
|
||||
(irc-away . ,(create-image (concat erc-nicklist-icons-directory
|
||||
"irc-offline.png")))
|
||||
(icq . ,(create-image (concat erc-nicklist-icons-directory
|
||||
"icq-online.png")))
|
||||
(icq-away . ,(create-image (concat erc-nicklist-icons-directory
|
||||
"icq-offline.png"))))))
|
||||
(erc-nicklist-make-window)
|
||||
(with-current-buffer (get-buffer (erc-nicklist-buffer-name channel))
|
||||
(erc-nicklist-insert-contents channel)))
|
||||
(add-hook 'erc-channel-members-changed-hook #'erc-nicklist-update))
|
||||
|
||||
(defun erc-nicklist-update ()
|
||||
"Update the ERC nicklist buffer."
|
||||
(let ((b (get-buffer (erc-nicklist-buffer-name)))
|
||||
(channel (current-buffer)))
|
||||
(when b
|
||||
(with-current-buffer b
|
||||
(erc-nicklist-insert-contents channel)))))
|
||||
|
||||
(defvar erc-nicklist-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "<down-mouse-3>") 'erc-nicklist-menu)
|
||||
(define-key map "\C-j" 'erc-nicklist-kbd-menu)
|
||||
(define-key map "q" 'erc-nicklist-quit)
|
||||
(define-key map (kbd "RET") 'erc-nicklist-kbd-cmd-QUERY)
|
||||
map)
|
||||
"Keymap for `erc-nicklist-mode'.")
|
||||
|
||||
(define-derived-mode erc-nicklist-mode fundamental-mode
|
||||
"Nicklist"
|
||||
"Major mode for the ERC nicklist buffer."
|
||||
(setq buffer-read-only t))
|
||||
|
||||
(defun erc-nicklist-call-erc-command (command point buffer window)
|
||||
"Call an ERC COMMAND.
|
||||
|
||||
Depending on what COMMAND is, it's called with one of POINT, BUFFER,
|
||||
or WINDOW as arguments."
|
||||
(when command
|
||||
(let* ((p (text-properties-at point))
|
||||
(b (plist-get p 'erc-nicklist-channel)))
|
||||
(if (memq command '(erc-nicklist-quit ignore))
|
||||
(funcall command window)
|
||||
;; EEEK! Horrble, but it's the only way we can ensure the
|
||||
;; response goes to the correct buffer.
|
||||
(erc-set-active-buffer b)
|
||||
(switch-to-buffer-other-window b)
|
||||
(funcall command (plist-get p 'erc-nicklist-nick))))))
|
||||
|
||||
(defun erc-nicklist-cmd-QUERY (user &optional server)
|
||||
"Opens a query buffer with USER."
|
||||
;; FIXME: find a way to switch to that buffer afterwards...
|
||||
(let ((send (if server
|
||||
(format "QUERY %s %s" user server)
|
||||
(format "QUERY %s" user))))
|
||||
(erc-cmd-QUERY user)
|
||||
t))
|
||||
|
||||
(defun erc-nicklist-kbd-cmd-QUERY (&optional window)
|
||||
(interactive)
|
||||
(let* ((p (text-properties-at (point)))
|
||||
(server (plist-get p 'erc-nicklist-channel))
|
||||
(nick (plist-get p 'erc-nicklist-nick))
|
||||
(nick (or (and (string-match "(\\(.*\\))" nick)
|
||||
(match-string 1 nick))
|
||||
nick))
|
||||
(nick (or (and (string-match "\\+\\(.*\\)" nick)
|
||||
(match-string 1 nick))
|
||||
nick))
|
||||
(send (format "QUERY %s %s" nick server)))
|
||||
(switch-to-buffer-other-window server)
|
||||
(erc-cmd-QUERY nick)))
|
||||
|
||||
|
||||
(defvar erc-nicklist-menu
|
||||
(let ((map (make-sparse-keymap "Action")))
|
||||
(define-key map [erc-cmd-WHOIS]
|
||||
'("Whois" . erc-cmd-WHOIS))
|
||||
(define-key map [erc-cmd-DEOP]
|
||||
'("Deop" . erc-cmd-DEOP))
|
||||
(define-key map [erc-cmd-MSG]
|
||||
'("Message" . erc-cmd-MSG)) ;; TODO!
|
||||
(define-key map [erc-nicklist-cmd-QUERY]
|
||||
'("Query" . erc-nicklist-kbd-cmd-QUERY))
|
||||
(define-key map [ignore]
|
||||
'("Cancel" . ignore))
|
||||
(define-key map [erc-nicklist-quit]
|
||||
'("Close nicklist" . erc-nicklist-quit))
|
||||
map)
|
||||
"Menu keymap for the ERC nicklist.")
|
||||
|
||||
(defun erc-nicklist-quit (&optional window)
|
||||
"Delete the ERC nicklist.
|
||||
|
||||
Deletes WINDOW and stops updating the nicklist buffer."
|
||||
(interactive)
|
||||
(let ((b (window-buffer window)))
|
||||
(with-current-buffer b
|
||||
(set-buffer-modified-p nil)
|
||||
(kill-this-buffer)
|
||||
(remove-hook 'erc-channel-members-changed-hook 'erc-nicklist-update))))
|
||||
|
||||
|
||||
(defun erc-nicklist-kbd-menu ()
|
||||
"Show the ERC nicklist menu."
|
||||
(interactive)
|
||||
(let* ((point (point))
|
||||
(window (selected-window))
|
||||
(buffer (current-buffer)))
|
||||
(with-current-buffer buffer
|
||||
(erc-nicklist-call-erc-command
|
||||
(car (x-popup-menu point
|
||||
erc-nicklist-menu))
|
||||
point
|
||||
buffer
|
||||
window))))
|
||||
|
||||
(defun erc-nicklist-menu (&optional arg)
|
||||
"Show the ERC nicklist menu.
|
||||
|
||||
ARG is a parametrized event (see `interactive')."
|
||||
(interactive "e")
|
||||
(let* ((point (nth 1 (cadr arg)))
|
||||
(window (car (cadr arg)))
|
||||
(buffer (window-buffer window)))
|
||||
(with-current-buffer buffer
|
||||
(erc-nicklist-call-erc-command
|
||||
(car (x-popup-menu arg
|
||||
erc-nicklist-menu))
|
||||
point
|
||||
buffer
|
||||
window))))
|
||||
|
||||
|
||||
(defun erc-nicklist-channel-users-info (channel)
|
||||
"Return a nick-sorted list of all users on CHANNEL.
|
||||
Result are elements in the form (SERVER-USER . CHANNEL-USER). The
|
||||
list has all the voiced users according to
|
||||
`erc-nicklist-voiced-position'."
|
||||
(let* ((nicks (erc-sort-channel-users-alphabetically
|
||||
(with-current-buffer channel (erc-get-channel-user-list)))))
|
||||
(if erc-nicklist-voiced-position
|
||||
(let ((voiced-nicks (erc-remove-if-not
|
||||
#'(lambda (x)
|
||||
(null (erc-channel-user-voice (cdr x))))
|
||||
nicks))
|
||||
(devoiced-nicks (erc-remove-if-not
|
||||
#'(lambda (x)
|
||||
(erc-channel-user-voice
|
||||
(cdr x)))
|
||||
nicks)))
|
||||
(cond ((eq erc-nicklist-voiced-position 'top)
|
||||
(append devoiced-nicks voiced-nicks))
|
||||
((eq erc-nicklist-voiced-position 'bottom)
|
||||
(append voiced-nicks devoiced-nicks))))
|
||||
nicks)))
|
||||
|
||||
|
||||
|
||||
(provide 'erc-nicklist)
|
||||
|
||||
;;; erc-nicklist.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: db37a256-87a7-4544-bd90-e5f16c9f5ca5
|
||||
337
lisp/erc/erc-nickserv.el
Normal file
337
lisp/erc/erc-nickserv.el
Normal file
|
|
@ -0,0 +1,337 @@
|
|||
;;; erc-nickserv.el --- Identify to NickServ
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004 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 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:
|
||||
|
||||
;; There are two ways to go about identifying yourself automatically to
|
||||
;; NickServ with this module. The more secure way is to listen for identify
|
||||
;; requests from the user NickServ. Another way is to identify yourself to
|
||||
;; NickServ directly after a successful connection and every time you change
|
||||
;; your nickname. This method is rather insecure, though, because no checks
|
||||
;; are made to test if NickServ is the real NickServ for a given network or
|
||||
;; server.
|
||||
|
||||
;; As a default, ERC has the data for the official nickname services on the
|
||||
;; networks Austnet, BrasNET, Dalnet, freenode, GalaxyNet, and Slashnet.
|
||||
;; You can add more by using M-x customize-variable RET erc-nickserv-alist.
|
||||
|
||||
;; Usage:
|
||||
;;
|
||||
;; Put into your .emacs:
|
||||
;;
|
||||
;; (require 'erc-nickserv)
|
||||
;; (erc-services-mode 1)
|
||||
;;
|
||||
;; Add your nickname and NickServ password to `erc-nickserv-passwords'.
|
||||
;; Using the freenode network as an example:
|
||||
;;
|
||||
;; (setq erc-nickserv-passwords '((freenode (("nickname" "password")))))
|
||||
;;
|
||||
;; The default automatic identification mode is autodetection of NickServ
|
||||
;; identify requests. Set the variable `erc-nickserv-identify-mode' if
|
||||
;; you'd like to change this behavior. You can also change the way
|
||||
;; automatic identification is handled by using:
|
||||
;;
|
||||
;; M-x erc-nickserv-identify-mode
|
||||
;;
|
||||
;; If you'd rather not identify yourself automatically but would like access
|
||||
;; to the functions contained in this file, just load this file without
|
||||
;; enabling `erc-services-mode'.
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'erc-nets)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;; Customization:
|
||||
|
||||
(defgroup erc-services nil
|
||||
"Configuration for IRC services.
|
||||
|
||||
On some networks, there exists a special type of automated irc bot,
|
||||
called Services. Those usually allow you to register your nickname,
|
||||
post/read memos to other registered users who are currently offline,
|
||||
and do various other things.
|
||||
|
||||
This group allows you to set variables to somewhat automate
|
||||
communication with those Services."
|
||||
:group 'erc)
|
||||
|
||||
;;;###autoload (autoload 'erc-services-mode "erc-nickserv" nil t)
|
||||
(define-erc-module services nickserv
|
||||
"This mode automates communication with services."
|
||||
((erc-nickserv-identify-mode erc-nickserv-identify-mode))
|
||||
((remove-hook 'erc-server-NOTICE-functions
|
||||
'erc-nickserv-identify-autodetect)
|
||||
(remove-hook 'erc-after-connect
|
||||
'erc-nickserv-identify-on-connect)
|
||||
(remove-hook 'erc-nick-changed-functions
|
||||
'erc-nickserv-identify-on-nick-change)))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-nickserv-identify-mode (mode)
|
||||
"Set up hooks according to which MODE the user has chosen."
|
||||
(interactive
|
||||
(list (intern (completing-read
|
||||
"Choose Nickserv identify mode (RET to disable): "
|
||||
'(("autodetect") ("nick-change")) nil t))))
|
||||
(cond ((eq mode 'autodetect)
|
||||
(setq erc-nickserv-identify-mode 'autodetect)
|
||||
(add-hook 'erc-server-NOTICE-functions
|
||||
'erc-nickserv-identify-autodetect)
|
||||
(remove-hook 'erc-nick-changed-functions
|
||||
'erc-nickserv-identify-on-nick-change)
|
||||
(remove-hook 'erc-after-connect
|
||||
'erc-nickserv-identify-on-connect))
|
||||
((eq mode 'nick-change)
|
||||
(setq erc-nickserv-identify-mode 'nick-change)
|
||||
(add-hook 'erc-after-connect
|
||||
'erc-nickserv-identify-on-connect)
|
||||
(add-hook 'erc-nick-changed-functions
|
||||
'erc-nickserv-identify-on-nick-change)
|
||||
(remove-hook 'erc-server-NOTICE-functions
|
||||
'erc-nickserv-identify-autodetect))
|
||||
(t
|
||||
(setq erc-nickserv-identify-mode nil)
|
||||
(remove-hook 'erc-server-NOTICE-functions
|
||||
'erc-nickserv-identify-autodetect)
|
||||
(remove-hook 'erc-after-connect
|
||||
'erc-nickserv-identify-on-connect)
|
||||
(remove-hook 'erc-nick-changed-functions
|
||||
'erc-nickserv-identify-on-nick-change))))
|
||||
|
||||
(defcustom erc-nickserv-identify-mode 'autodetect
|
||||
"The mode which is used when identifying to Nickserv.
|
||||
|
||||
Possible settings are:.
|
||||
|
||||
'autodetect - Identify when the real Nickserv sends an identify request.
|
||||
'nick-change - Identify when you change your nickname.
|
||||
nil - Disables automatic Nickserv identification.
|
||||
|
||||
You can also use M-x erc-nickserv-identify-mode to change modes."
|
||||
:group 'erc-services
|
||||
:type '(choice (const autodetect)
|
||||
(const nick-change)
|
||||
(const nil))
|
||||
:set (lambda (sym val)
|
||||
(set-default sym val)
|
||||
(erc-nickserv-identify-mode val)))
|
||||
|
||||
(defcustom erc-prompt-for-nickserv-password t
|
||||
"Ask for the password when identifying to NickServ."
|
||||
:group 'erc-services
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-nickserv-passwords nil
|
||||
"Passwords used when identifying to NickServ automatically.
|
||||
|
||||
Example of use:
|
||||
(setq erc-nickserv-passwords
|
||||
'((freenode ((\"nick-one\" . \"password\")
|
||||
(\"nick-two\" . \"password\")))
|
||||
(DALnet ((\"nick\" . \"password\")))))"
|
||||
:group 'erc-services
|
||||
:type '(repeat
|
||||
(list :tag "Network"
|
||||
(choice :tag "Network name"
|
||||
(const freenode)
|
||||
(const DALnet)
|
||||
(const GalaxyNet)
|
||||
(const SlashNET)
|
||||
(const BRASnet)
|
||||
(const iip)
|
||||
(const Austnet)
|
||||
(symbol :tag "Network name"))
|
||||
(repeat :tag "Nickname and password"
|
||||
(cons :tag "Identity"
|
||||
(string :tag "Nick")
|
||||
(string :tag "Password"))))))
|
||||
|
||||
;; Variables:
|
||||
|
||||
(defcustom erc-nickserv-alist
|
||||
'((DALnet
|
||||
"NickServ!service@dal.net"
|
||||
"/msg\\s-NickServ@services.dal.net\\s-IDENTIFY\\s-<password>"
|
||||
"NickServ@services.dal.net"
|
||||
"IDENTIFY"
|
||||
nil)
|
||||
(freenode
|
||||
"NickServ!NickServ@services."
|
||||
"/msg\\s-NickServ\\s-IDENTIFY\\s-<password>"
|
||||
"NickServ"
|
||||
"IDENTIFY"
|
||||
nil)
|
||||
(GalaxyNet
|
||||
"NS!nickserv@galaxynet.org"
|
||||
"Please\\s-change\\s-nicks\\s-or\\s-authenticate."
|
||||
"NS@services.galaxynet.org"
|
||||
"AUTH"
|
||||
t)
|
||||
(SlashNET
|
||||
"NickServ!services@services.slashnet.org"
|
||||
"/msg\\s-NickServ\\s-IDENTIFY\\s- password"
|
||||
"NickServ@services.slashnet.org"
|
||||
"IDENTIFY"
|
||||
nil)
|
||||
(iip
|
||||
"Trent@anon.iip"
|
||||
"type\\s-/squery\\s-Trent\\s-identify\\s-<password>"
|
||||
"Trent@anon.iip"
|
||||
"IDENTIFY"
|
||||
nil
|
||||
"SQUERY")
|
||||
(BRASnet
|
||||
"NickServ!services@brasnet.org"
|
||||
"/NickServ\\s-IDENTIFY\\s- senha "
|
||||
"NickServ"
|
||||
"IDENTIFY"
|
||||
nil
|
||||
"")
|
||||
(Austnet
|
||||
"NickOP!service@austnet.org"
|
||||
"/msg\\s-NickOP@austnet.org\\s-identify\\s-<password>"
|
||||
"nickop@austnet.org"
|
||||
"identify"
|
||||
nil)
|
||||
(Azzurra
|
||||
"NickServ!service@azzurra.org"
|
||||
"/ns\\s-IDENTIFY\\s-password"
|
||||
"NickServ"
|
||||
"IDENTIFY"
|
||||
nil)
|
||||
(OFTC
|
||||
"NickServ!services@services.oftc.net"
|
||||
"/msg\\s-NickServ\\s-IDENTIFY\\s-\^_password"
|
||||
"NickServ"
|
||||
"IDENTIFY"
|
||||
nil))
|
||||
"Alist of NickServer details, sorted by network.
|
||||
Every element in the list has the form
|
||||
\(SYMBOL NICKSERV REGEXP NICK KEYWORD USE-CURRENT ANSWER)
|
||||
|
||||
SYMBOL is a network identifier, a symbol, as used in `erc-networks-alist'.
|
||||
NICKSERV is the description of the nickserv in the form nick!user@host.
|
||||
REGEXP is a regular expression matching the message from nickserv.
|
||||
NICK is nickserv's nickname. Use nick@server where necessary/possible.
|
||||
KEYWORD is the keyword to use in the reply message to identify yourself.
|
||||
USE-CURRENT indicates whether the current nickname must be used when
|
||||
identifying.
|
||||
ANSWER is the command to use for the answer. The default is 'privmsg.
|
||||
This last element is optional."
|
||||
:group 'erc-services
|
||||
:type '(repeat
|
||||
(list :tag "Nickserv data"
|
||||
(symbol :tag "Network name")
|
||||
(string :tag "Nickserv's nick!user@host")
|
||||
(regexp :tag "Identify request sent by Nickserv")
|
||||
(string :tag "Identify to")
|
||||
(string :tag "Identify keyword")
|
||||
(boolean :tag "Use current nick in identify message?")
|
||||
(choice :tag "Command to use (optional)"
|
||||
(string :tag "Command")
|
||||
(const :tag "No special command necessary" nil)))))
|
||||
|
||||
;; Functions:
|
||||
|
||||
(defun erc-nickserv-identify-autodetect (proc parsed)
|
||||
"Check for a NickServ identify request everytime a notice is received.
|
||||
Make sure it is the real NickServ for this network and that it has
|
||||
specifically asked the user to IDENTIFY.
|
||||
If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the
|
||||
password for this nickname, otherwise try to send it automatically."
|
||||
(unless (and (null erc-nickserv-passwords)
|
||||
(null erc-prompt-for-nickserv-password))
|
||||
(let* ((network (erc-network))
|
||||
(nickserv (nth 1 (assoc network erc-nickserv-alist)))
|
||||
(identify-regex (nth 2 (assoc network erc-nickserv-alist)))
|
||||
(sspec (erc-response.sender parsed))
|
||||
(nick (car (erc-response.command-args parsed)))
|
||||
(msg (erc-response.contents parsed)))
|
||||
;; continue only if we're sure it's the real nickserv for this network
|
||||
;; and it's asked us to identify
|
||||
(when (and nickserv (equal sspec nickserv)
|
||||
(string-match identify-regex msg))
|
||||
(erc-log "NickServ IDENTIFY request detected")
|
||||
(erc-nickserv-call-identify-function nick)
|
||||
nil))))
|
||||
|
||||
(defun erc-nickserv-identify-on-connect (server nick)
|
||||
"Identify to Nickserv after the connection to the server is established."
|
||||
(unless (and (null erc-nickserv-passwords)
|
||||
(null erc-prompt-for-nickserv-password))
|
||||
(erc-nickserv-call-identify-function nick)))
|
||||
|
||||
(defun erc-nickserv-identify-on-nick-change (nick old-nick)
|
||||
"Identify to Nickserv whenever your nick changes."
|
||||
(unless (and (null erc-nickserv-passwords)
|
||||
(null erc-prompt-for-nickserv-password))
|
||||
(erc-nickserv-call-identify-function nick)))
|
||||
|
||||
(defun erc-nickserv-call-identify-function (nickname)
|
||||
"Call `erc-nickserv-identify' interactively or run it with NICKNAME's
|
||||
password.
|
||||
The action is determined by the value of `erc-prompt-for-nickserv-password'."
|
||||
(if erc-prompt-for-nickserv-password
|
||||
(call-interactively 'erc-nickserv-identify)
|
||||
(when erc-nickserv-passwords
|
||||
(erc-nickserv-identify
|
||||
(cdr (assoc nickname
|
||||
(nth 1 (assoc (erc-network)
|
||||
erc-nickserv-passwords))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-nickserv-identify (password)
|
||||
"Send an \"identify <PASSWORD>\" message to NickServ.
|
||||
When called interactively, read the password using `read-passwd'."
|
||||
(interactive
|
||||
(list (read-passwd
|
||||
(format "NickServ password for %s on %s (RET to cancel): "
|
||||
(erc-current-nick)
|
||||
(or (and (erc-network)
|
||||
(symbol-name (erc-network)))
|
||||
"Unknown network")))))
|
||||
(when (and password (not (string= "" password)))
|
||||
(let* ((erc-auto-discard-away nil)
|
||||
(network (erc-network))
|
||||
(nickserv-info (assoc network erc-nickserv-alist))
|
||||
(nickserv (or (nth 3 nickserv-info) "NickServ"))
|
||||
(identify-word (or (nth 4 nickserv-info) "IDENTIFY"))
|
||||
(nick (if (nth 5 nickserv-info)
|
||||
(concat (erc-current-nick) " ")
|
||||
""))
|
||||
(msgtype (or (nth 6 nickserv-info) "PRIVMSG")))
|
||||
(erc-message msgtype
|
||||
(concat nickserv " " identify-word " " nick password)))))
|
||||
|
||||
(provide 'erc-nickserv)
|
||||
|
||||
;;; erc-nickserv.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: d401c8aa-d938-4255-96a9-3efb64c47e58
|
||||
254
lisp/erc/erc-notify.el
Normal file
254
lisp/erc/erc-notify.el
Normal file
|
|
@ -0,0 +1,254 @@
|
|||
;;; erc-notify.el --- Online status change notification
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@lexx.delysid.org>
|
||||
;; Keywords: comm
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This module defines a new command, /NOTIFY
|
||||
;; See the docstring of `erc-cmd-NOTIFY' for details.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'erc-nets)
|
||||
(eval-when-compile
|
||||
(require 'cl)
|
||||
(require 'pcomplete))
|
||||
|
||||
;;;; Customizable variables
|
||||
|
||||
(defgroup erc-notify nil
|
||||
"Track online status of certain nicknames."
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-notify-list nil
|
||||
"*List of nicknames you want to be notified about online/offline
|
||||
status change."
|
||||
:group 'erc-notify
|
||||
:type '(repeat string))
|
||||
|
||||
(defcustom erc-notify-interval 60
|
||||
"*Time interval (in seconds) for checking online status of notificated
|
||||
people."
|
||||
:group 'erc-notify
|
||||
:type 'integer)
|
||||
|
||||
(defcustom erc-notify-signon-hook nil
|
||||
"*Hook run after someone on `erc-notify-list' has signed on.
|
||||
Two arguments are passed to the function, SERVER and NICK, both
|
||||
strings."
|
||||
:group 'erc-notify
|
||||
:type 'hook
|
||||
:options '(erc-notify-signon))
|
||||
|
||||
(defcustom erc-notify-signoff-hook nil
|
||||
"*Hook run after someone on `erc-notify-list' has signed off.
|
||||
Two arguments are passed to the function, SERVER and NICK, both
|
||||
strings."
|
||||
:group 'erc-notify
|
||||
:type 'hook
|
||||
:options '(erc-notify-signoff))
|
||||
|
||||
(defun erc-notify-signon (server nick)
|
||||
(message "%s signed on at %s" nick server))
|
||||
|
||||
(defun erc-notify-signoff (server nick)
|
||||
(message "%s signed off from %s" nick server))
|
||||
|
||||
;;;; Internal variables
|
||||
|
||||
(defvar erc-last-ison nil
|
||||
"Last ISON information received through `erc-notify-timer'.")
|
||||
(make-variable-buffer-local 'erc-last-ison)
|
||||
|
||||
(defvar erc-last-ison-time 0
|
||||
"Last time ISON was sent to the server in `erc-notify-timer'.")
|
||||
(make-variable-buffer-local 'erc-last-ison-time)
|
||||
|
||||
;;;; Setup
|
||||
|
||||
(defun erc-notify-install-message-catalogs ()
|
||||
(erc-define-catalog
|
||||
'english
|
||||
'((notify_current . "Notificated people online: %l")
|
||||
(notify_list . "Current notify list: %l")
|
||||
(notify_on . "Detected %n on IRC network %m")
|
||||
(notify_off . "%n has left IRC network %m"))))
|
||||
|
||||
;;;###autoload (autoload 'erc-notify-mode "erc-notify" nil t)
|
||||
(define-erc-module notify nil
|
||||
"Periodically check for the online status of certain users and report
|
||||
changes."
|
||||
((add-hook 'erc-timer-hook 'erc-notify-timer)
|
||||
(add-hook 'erc-server-JOIN-functions 'erc-notify-JOIN)
|
||||
(add-hook 'erc-server-NICK-functions 'erc-notify-NICK)
|
||||
(add-hook 'erc-server-QUIT-functions 'erc-notify-QUIT))
|
||||
((remove-hook 'erc-timer-hook 'erc-notify-timer)
|
||||
(remove-hook 'erc-server-JOIN-functions 'erc-notify-JOIN)
|
||||
(remove-hook 'erc-server-NICK-functions 'erc-notify-NICK)
|
||||
(remove-hook 'erc-server-QUIT-functions 'erc-notify-QUIT)))
|
||||
|
||||
;;;; Timer handler
|
||||
|
||||
(defun erc-notify-timer (now)
|
||||
(when (and erc-notify-list
|
||||
(> (erc-time-diff
|
||||
erc-last-ison-time now)
|
||||
erc-notify-interval))
|
||||
(erc-once-with-server-event
|
||||
303
|
||||
'(let* ((server (erc-response.sender parsed))
|
||||
(ison-list (delete "" (split-string
|
||||
(erc-response.contents parsed))))
|
||||
(new-list ison-list)
|
||||
(old-list (with-current-buffer (erc-server-buffer)
|
||||
erc-last-ison)))
|
||||
(while new-list
|
||||
(when (not (erc-member-ignore-case (car new-list) old-list))
|
||||
(run-hook-with-args 'erc-notify-signon-hook server (car new-list))
|
||||
(erc-display-message
|
||||
parsed 'notice proc
|
||||
'notify_on ?n (car new-list) ?m (erc-network-name)))
|
||||
(setq new-list (cdr new-list)))
|
||||
(while old-list
|
||||
(when (not (erc-member-ignore-case (car old-list) ison-list))
|
||||
(run-hook-with-args 'erc-notify-signoff-hook server (car old-list))
|
||||
(erc-display-message
|
||||
parsed 'notice proc
|
||||
'notify_off ?n (car old-list) ?m (erc-network-name)))
|
||||
(setq old-list (cdr old-list)))
|
||||
(setq erc-last-ison ison-list)
|
||||
t))
|
||||
(erc-server-send
|
||||
(concat "ISON " (mapconcat 'identity erc-notify-list " ")))
|
||||
(setq erc-last-ison-time now)))
|
||||
|
||||
(defun erc-notify-JOIN (proc parsed)
|
||||
"Check if channel joiner is on `erc-notify-list' and not on `erc-last-ison'.
|
||||
If this condition is satisfied, produce a notify_on message and add the nick
|
||||
to `erc-last-ison' to prevent any further notifications."
|
||||
(let ((nick (erc-extract-nick (erc-response.sender parsed))))
|
||||
(when (and (erc-member-ignore-case nick erc-notify-list)
|
||||
(not (erc-member-ignore-case nick erc-last-ison)))
|
||||
(add-to-list 'erc-last-ison nick)
|
||||
(run-hook-with-args 'erc-notify-signon-hook
|
||||
(or erc-server-announced-name erc-session-server)
|
||||
nick)
|
||||
(erc-display-message
|
||||
parsed 'notice proc
|
||||
'notify_on ?n nick ?m (erc-network-name)))
|
||||
nil))
|
||||
|
||||
(defun erc-notify-NICK (proc parsed)
|
||||
"Check if new nick is on `erc-notify-list' and not on `erc-last-ison'.
|
||||
If this condition is satisfied, produce a notify_on message and add the nick
|
||||
to `erc-last-ison' to prevent any further notifications."
|
||||
(let ((nick (erc-response.contents parsed)))
|
||||
(when (and (erc-member-ignore-case nick erc-notify-list)
|
||||
(not (erc-member-ignore-case nick erc-last-ison)))
|
||||
(add-to-list 'erc-last-ison nick)
|
||||
(run-hook-with-args 'erc-notify-signon-hook
|
||||
(or erc-server-announced-name erc-session-server)
|
||||
nick)
|
||||
(erc-display-message
|
||||
parsed 'notice proc
|
||||
'notify_on ?n nick ?m (erc-network-name)))
|
||||
nil))
|
||||
|
||||
(defun erc-notify-QUIT (proc parsed)
|
||||
"Check if quitter is on `erc-notify-list' and on `erc-last-ison'.
|
||||
If this condition is satisfied, produce a notify_off message and remove the
|
||||
nick from `erc-last-ison' to prevent any further notifications."
|
||||
(let ((nick (erc-extract-nick (erc-response.sender parsed))))
|
||||
(when (and (erc-member-ignore-case nick erc-notify-list)
|
||||
(erc-member-ignore-case nick erc-last-ison))
|
||||
(setq erc-last-ison (erc-delete-if `(lambda (el)
|
||||
(string= ,(erc-downcase nick)
|
||||
(erc-downcase el)))
|
||||
erc-last-ison))
|
||||
(run-hook-with-args 'erc-notify-signoff-hook
|
||||
(or erc-server-announced-name erc-session-server)
|
||||
nick)
|
||||
(erc-display-message
|
||||
parsed 'notice proc
|
||||
'notify_off ?n nick ?m (erc-network-name)))
|
||||
nil))
|
||||
|
||||
;;;; User level command
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-cmd-NOTIFY (&rest args)
|
||||
"Change `erc-notify-list' or list current notify-list members online.
|
||||
Without args, list the current list of notificated people online,
|
||||
with args, toggle notify status of people."
|
||||
(cond
|
||||
((null args)
|
||||
;; Print current notificated people (online)
|
||||
(let ((ison (with-current-buffer (erc-server-buffer) erc-last-ison)))
|
||||
(if (not ison)
|
||||
(erc-display-message
|
||||
nil 'notice 'active "No ison-list yet!")
|
||||
(erc-display-message
|
||||
nil 'notice 'active
|
||||
'notify_current ?l ison))))
|
||||
((string= (car args) "-l")
|
||||
(erc-display-message nil 'notice 'active
|
||||
'notify_list ?l (mapconcat 'identity erc-notify-list
|
||||
" ")))
|
||||
(t
|
||||
(while args
|
||||
(if (erc-member-ignore-case (car args) erc-notify-list)
|
||||
(progn
|
||||
(setq erc-notify-list (delete (car args) erc-notify-list))
|
||||
;; Remove the nick from the value of erc-last-ison in
|
||||
;; every server buffer. This prevents seeing a signoff
|
||||
;; notification for a nick that you have just _removed_
|
||||
;; from your notify list.
|
||||
(dolist (buf (erc-buffer-list))
|
||||
(with-current-buffer buf
|
||||
(if (erc-server-buffer-p)
|
||||
(setq erc-last-ison (delete (car args) erc-last-ison))))))
|
||||
(setq erc-notify-list (cons (erc-string-no-properties (car args))
|
||||
erc-notify-list)))
|
||||
(setq args (cdr args)))
|
||||
(erc-display-message
|
||||
nil 'notice 'active
|
||||
'notify_list ?l (mapconcat 'identity erc-notify-list " "))))
|
||||
t)
|
||||
|
||||
;;;###autoload
|
||||
(defun pcomplete/erc-mode/NOTIFY ()
|
||||
(pcomplete-here (pcomplete-erc-all-nicks)))
|
||||
|
||||
(erc-notify-install-message-catalogs)
|
||||
|
||||
(provide 'erc-notify)
|
||||
|
||||
;;; erc-notify.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 0fb19dd0-1359-458a-89b7-81dc195a588e
|
||||
108
lisp/erc/erc-page.el
Normal file
108
lisp/erc/erc-page.el
Normal file
|
|
@ -0,0 +1,108 @@
|
|||
;; erc-page.el - CTCP PAGE support for ERC
|
||||
|
||||
;; Copyright (C) 2002, 2004 Free Software Foundation
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Requiring this file will make ERC react to CTCP PAGE messages
|
||||
;; received, and it will provide a new /PAGE command to send such
|
||||
;; messages yourself. To enable it, customize the variable
|
||||
;; `erc-page-mode'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
|
||||
;;;###autoload (autoload 'erc-page-mode "erc-page")
|
||||
(define-erc-module page ctcp-page
|
||||
"Process CTCP PAGE requests from IRC."
|
||||
nil nil)
|
||||
|
||||
(erc-define-catalog-entry 'english 'CTCP-PAGE "Page from %n (%u@%h): %m")
|
||||
|
||||
(defgroup erc-page nil
|
||||
"React to CTCP PAGE messages."
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-page-function nil
|
||||
"A function to process a \"page\" request.
|
||||
If nil, this prints the page message in the minibuffer and calls
|
||||
`beep'. If non-nil, it must be a function that takes two arguments:
|
||||
SENDER and MSG, both strings.
|
||||
|
||||
Example for your ~/.emacs file:
|
||||
|
||||
\(setq erc-page-function
|
||||
(lambda (sender msg)
|
||||
(play-sound-file \"/home/alex/elisp/erc/sounds/ni.wav\")
|
||||
(message \"IRC Page from %s: %s\" sender msg)))"
|
||||
:group 'erc-page
|
||||
:type '(choice (const nil)
|
||||
(function)))
|
||||
|
||||
(defcustom erc-ctcp-query-PAGE-hook '(erc-ctcp-query-PAGE)
|
||||
"List of functions to be called when a CTCP PAGE is received.
|
||||
This is called from `erc-process-ctcp-query'. The functions are called
|
||||
with six arguments: PROC NICK LOGIN HOST TO MSG. Note that you can
|
||||
also set `erc-page-function' to a function, which only gets two arguments,
|
||||
SENDER and MSG, so that might be easier to use."
|
||||
:group 'erc-page
|
||||
:type '(repeat function))
|
||||
|
||||
(defun erc-ctcp-query-PAGE (proc nick login host to msg)
|
||||
"Deal with an CTCP PAGE query, if `erc-page-mode' is non-nil.
|
||||
This will call `erc-page-function', if defined, or it will just print
|
||||
a message and `beep'. In addition to that, the page message is also
|
||||
inserted into the server buffer."
|
||||
(when (and erc-page-mode
|
||||
(string-match "PAGE\\(\\s-+.*\\)?$" msg))
|
||||
(let* ((m (match-string 1 msg))
|
||||
(page-msg (if m (erc-controls-interpret (substring m 1))
|
||||
"[no message]"))
|
||||
text)
|
||||
(if m (setq m (substring m 1)))
|
||||
(setq text (erc-format-message 'CTCP-PAGE
|
||||
?n nick ?u login
|
||||
?h host ?m page-msg))
|
||||
(if erc-page-function
|
||||
(funcall erc-page-function nick page-msg)
|
||||
;; if no function is defined
|
||||
(message "%s" text)
|
||||
(beep))
|
||||
;; insert text into buffer
|
||||
(erc-display-message
|
||||
nil 'notice nil text)))
|
||||
nil)
|
||||
|
||||
(defun erc-cmd-PAGE (line &optional force)
|
||||
"Send a CTCP page to the user given as the first word in LINE.
|
||||
The rest of LINE is the message to send. Note that you will only
|
||||
receive pages if `erc-page-mode' is on."
|
||||
(when (string-match "^\\s-*\\(\\S-+\\) ?\\(.*\\)" line)
|
||||
(let ((nick (match-string 1 line))
|
||||
(msg (match-string 2 line)))
|
||||
(erc-cmd-CTCP nick "PAGE" msg))))
|
||||
|
||||
(put 'erc-cmd-PAGE 'do-not-parse-args t)
|
||||
|
||||
(provide 'erc-page)
|
||||
|
||||
;; arch-tag: 82fd2e0e-6060-4dd2-9788-8c1411e844de
|
||||
;;; erc-page.el ends here
|
||||
275
lisp/erc/erc-pcomplete.el
Normal file
275
lisp/erc/erc-pcomplete.el
Normal file
|
|
@ -0,0 +1,275 @@
|
|||
;;; erc-pcomplete.el --- Provides programmable completion for ERC
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Sacha Chua <sacha@free.net.ph>
|
||||
;; Keywords: comm, convenience
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcCompletion
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file replaces erc-complete.el. It provides nick completion
|
||||
;; for ERC based on pcomplete. If you do not have pcomplete, you may
|
||||
;; try to use erc-complete.el.
|
||||
;;
|
||||
;; To use, (require 'erc-auto) or (require 'erc-pcomplete), then
|
||||
;; (erc-pcomplete-mode 1)
|
||||
;;
|
||||
;; If you want nickname completions ordered such that the most recent
|
||||
;; speakers are listed first, set
|
||||
;; `erc-pcomplete-order-nickname-completions' to `t'.
|
||||
;;
|
||||
;; See CREDITS for other contributors.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(require 'pcomplete)
|
||||
(require 'erc)
|
||||
(require 'erc-compat)
|
||||
(require 'time-date)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup erc-pcomplete nil
|
||||
"Programmable completion for ERC"
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-pcomplete-nick-postfix ": "
|
||||
"*When `pcomplete' is used in the first word after the prompt,
|
||||
add this string to nicks completed."
|
||||
:group 'erc-pcomplete
|
||||
:type 'string)
|
||||
|
||||
(defcustom erc-pcomplete-order-nickname-completions t
|
||||
"If t, channel nickname completions will be ordered such that
|
||||
the most recent speakers are listed first."
|
||||
:group 'erc-pcomplete
|
||||
:type 'boolean)
|
||||
|
||||
;;;###autoload (autoload 'erc-completion-mode "erc-pcomplete" nil t)
|
||||
(define-erc-module pcomplete Completion
|
||||
"In ERC Completion mode, the TAB key does completion whenever possible."
|
||||
((add-hook 'erc-mode-hook 'pcomplete-erc-setup)
|
||||
(add-hook 'erc-complete-functions 'erc-pcomplete)
|
||||
(erc-buffer-list #'pcomplete-erc-setup))
|
||||
((remove-hook 'erc-mode-hook 'pcomplete-erc-setup)
|
||||
(remove-hook 'erc-complete-functions 'erc-pcomplete)))
|
||||
|
||||
(defun erc-pcomplete ()
|
||||
"Complete the nick before point."
|
||||
(interactive)
|
||||
(when (> (point) (erc-beg-of-input-line))
|
||||
(let ((last-command (if (eq last-command 'erc-complete-word)
|
||||
'pcomplete
|
||||
last-command)))
|
||||
(call-interactively 'pcomplete))
|
||||
t))
|
||||
|
||||
;;; Setup function
|
||||
|
||||
(defun pcomplete-erc-setup ()
|
||||
"Setup `erc-mode' to use pcomplete."
|
||||
(set (make-local-variable 'pcomplete-ignore-case)
|
||||
t)
|
||||
(set (make-local-variable 'pcomplete-use-paring)
|
||||
nil)
|
||||
(set (make-local-variable 'pcomplete-suffix-list)
|
||||
'(? ?:))
|
||||
(set (make-local-variable 'pcomplete-parse-arguments-function)
|
||||
'pcomplete-parse-erc-arguments)
|
||||
(set (make-local-variable 'pcomplete-command-completion-function)
|
||||
'pcomplete/erc-mode/complete-command)
|
||||
(set (make-local-variable 'pcomplete-command-name-function)
|
||||
'pcomplete-erc-command-name)
|
||||
(set (make-local-variable 'pcomplete-default-completion-function)
|
||||
(lambda () (pcomplete-here (pcomplete-erc-nicks)))))
|
||||
|
||||
;;; Programmable completion logic
|
||||
|
||||
(defun pcomplete/erc-mode/complete-command ()
|
||||
(pcomplete-here
|
||||
(append
|
||||
(pcomplete-erc-commands)
|
||||
(pcomplete-erc-nicks erc-pcomplete-nick-postfix))))
|
||||
|
||||
(defvar erc-pcomplete-ctcp-commands
|
||||
'("ACTION" "CLIENTINFO" "ECHO" "FINGER" "PING" "TIME" "USERINFO" "VERSION"))
|
||||
|
||||
(defun pcomplete/erc-mode/CTCP ()
|
||||
(pcomplete-here (pcomplete-erc-nicks))
|
||||
(pcomplete-here erc-pcomplete-ctcp-commands))
|
||||
|
||||
(defun pcomplete/erc-mode/CLEARTOPIC ()
|
||||
(pcomplete-here (pcomplete-erc-channels)))
|
||||
|
||||
(defun pcomplete/erc-mode/DEOP ()
|
||||
(while (pcomplete-here (pcomplete-erc-ops))))
|
||||
|
||||
(defun pcomplete/erc-mode/DESCRIBE ()
|
||||
(pcomplete-here (pcomplete-erc-nicks)))
|
||||
|
||||
(defun pcomplete/erc-mode/IDLE ()
|
||||
(while (pcomplete-here (pcomplete-erc-nicks))))
|
||||
|
||||
(defun pcomplete/erc-mode/KICK ()
|
||||
(pcomplete-here (pcomplete-erc-channels))
|
||||
(pcomplete-here (pcomplete-erc-nicks)))
|
||||
|
||||
(defun pcomplete/erc-mode/LOAD ()
|
||||
(pcomplete-here (pcomplete-entries)))
|
||||
|
||||
(defun pcomplete/erc-mode/MODE ()
|
||||
(pcomplete-here (pcomplete-erc-channels))
|
||||
(while (pcomplete-here (pcomplete-erc-nicks))))
|
||||
|
||||
(defun pcomplete/erc-mode/ME ()
|
||||
(while (pcomplete-here (pcomplete-erc-nicks))))
|
||||
|
||||
(defun pcomplete/erc-mode/SAY ()
|
||||
(pcomplete-here (pcomplete-erc-nicks))
|
||||
(pcomplete-here (pcomplete-erc-nicks))
|
||||
(while (pcomplete-here (pcomplete-erc-nicks))))
|
||||
|
||||
(defun pcomplete/erc-mode/MSG ()
|
||||
(pcomplete-here (append (pcomplete-erc-all-nicks)
|
||||
(pcomplete-erc-channels)))
|
||||
(while (pcomplete-here (pcomplete-erc-nicks))))
|
||||
|
||||
(defun pcomplete/erc-mode/NAMES ()
|
||||
(while (pcomplete-here (pcomplete-erc-channels))))
|
||||
|
||||
(defalias 'pcomplete/erc-mode/NOTICE 'pcomplete/erc-mode/MSG)
|
||||
|
||||
(defun pcomplete/erc-mode/OP ()
|
||||
(while (pcomplete-here (pcomplete-erc-not-ops))))
|
||||
|
||||
(defun pcomplete/erc-mode/PART ()
|
||||
(pcomplete-here (pcomplete-erc-channels)))
|
||||
|
||||
(defalias 'pcomplete/erc-mode/LEAVE 'pcomplete/erc-mode/PART)
|
||||
|
||||
(defun pcomplete/erc-mode/QUERY ()
|
||||
(pcomplete-here (append (pcomplete-erc-all-nicks)
|
||||
(pcomplete-erc-channels)))
|
||||
(while (pcomplete-here (pcomplete-erc-nicks)))
|
||||
)
|
||||
|
||||
(defun pcomplete/erc-mode/SOUND ()
|
||||
(while (pcomplete-here (pcomplete-entries))))
|
||||
|
||||
(defun pcomplete/erc-mode/TOPIC ()
|
||||
(pcomplete-here (pcomplete-erc-channels)))
|
||||
|
||||
(defun pcomplete/erc-mode/WHOIS ()
|
||||
(while (pcomplete-here (pcomplete-erc-nicks))))
|
||||
|
||||
(defun pcomplete/erc-mode/UNIGNORE ()
|
||||
(pcomplete-here (with-current-buffer (erc-server-buffer) erc-ignore-list)))
|
||||
|
||||
;;; Functions that provide possible completions.
|
||||
|
||||
(defun pcomplete-erc-commands ()
|
||||
"Returns a list of strings of the defined user commands."
|
||||
(let ((case-fold-search nil))
|
||||
(mapcar (lambda (x)
|
||||
(concat "/" (downcase (substring (symbol-name x) 8))))
|
||||
(apropos-internal "erc-cmd-[A-Z]+"))))
|
||||
|
||||
(defun pcomplete-erc-ops ()
|
||||
"Returns a list of nicks with ops."
|
||||
(let (ops)
|
||||
(maphash (lambda (nick cdata)
|
||||
(if (and (cdr cdata)
|
||||
(erc-channel-user-op (cdr cdata)))
|
||||
(setq ops (cons nick ops))))
|
||||
erc-channel-users)
|
||||
ops))
|
||||
|
||||
(defun pcomplete-erc-not-ops ()
|
||||
"Returns a list of nicks without ops."
|
||||
(let (not-ops)
|
||||
(maphash (lambda (nick cdata)
|
||||
(if (and (cdr cdata)
|
||||
(not (erc-channel-user-op (cdr cdata))))
|
||||
(setq not-ops (cons nick not-ops))))
|
||||
erc-channel-users)
|
||||
not-ops))
|
||||
|
||||
|
||||
(defun pcomplete-erc-nicks (&optional postfix)
|
||||
"Returns a list of nicks in the current channel."
|
||||
(let ((users (erc-get-channel-user-list)))
|
||||
(if erc-pcomplete-order-nickname-completions
|
||||
(setq users (erc-sort-channel-users-by-activity users)))
|
||||
(mapcar (lambda (x)
|
||||
(concat (erc-server-user-nickname (car x)) postfix))
|
||||
users)))
|
||||
|
||||
(defun pcomplete-erc-all-nicks (&optional postfix)
|
||||
"Returns a list of all nicks on the current server."
|
||||
(let (nicks)
|
||||
(with-current-buffer (process-buffer erc-server-process)
|
||||
(maphash (lambda (nick user)
|
||||
(setq nicks (cons (concat nick postfix) nicks)))
|
||||
erc-server-users))
|
||||
nicks))
|
||||
|
||||
(defun pcomplete-erc-channels ()
|
||||
"Returns a list of channels associated with the current server."
|
||||
(mapcar (lambda (buf) (with-current-buffer buf (erc-default-target)))
|
||||
(erc-channel-list erc-server-process)))
|
||||
|
||||
;;; Functions for parsing
|
||||
|
||||
(defun pcomplete-erc-command-name ()
|
||||
"Returns the command name of the first argument."
|
||||
(if (eq (elt (pcomplete-arg 'first) 0) ?/)
|
||||
(upcase (substring (pcomplete-arg 'first) 1))
|
||||
"SAY"))
|
||||
|
||||
(defun pcomplete-parse-erc-arguments ()
|
||||
"Returns a list of parsed whitespace-separated arguments.
|
||||
These are the words from the beginning of the line after the prompt
|
||||
up to where point is right now."
|
||||
(let* ((start erc-input-marker)
|
||||
(end (point))
|
||||
args beginnings)
|
||||
(save-excursion
|
||||
(if (< (skip-chars-backward " \t\n" start) 0)
|
||||
(setq args '("")
|
||||
beginnings (list end)))
|
||||
(setq end (point))
|
||||
(while (< (skip-chars-backward "^ \t\n" start) 0)
|
||||
(setq beginnings (cons (point) beginnings)
|
||||
args (cons (buffer-substring-no-properties
|
||||
(point) end)
|
||||
args))
|
||||
(skip-chars-backward " \t\n" start)
|
||||
(setq end (point))))
|
||||
(cons args beginnings)))
|
||||
|
||||
(provide 'erc-pcomplete)
|
||||
|
||||
;;; erc-pcomplete.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 32a7703b-be87-45a4-82f3-9eed5a628911
|
||||
93
lisp/erc/erc-replace.el
Normal file
93
lisp/erc/erc-replace.el
Normal file
|
|
@ -0,0 +1,93 @@
|
|||
;; erc-replace.el -- wash and massage messages inserted into the buffer
|
||||
|
||||
;; Copyright (C) 2001, 2002, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Andreas Fuchs <asf@void.at>
|
||||
;; Maintainer: Mario Lang (mlang@delysid.org)
|
||||
;; Keywords: IRC, client, Internet
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcReplace
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This module allows you to systematically replace text in incoming
|
||||
;; messages. Load erc-replace, and customize `erc-replace-alist'.
|
||||
;; Then add to your ~/.emacs:
|
||||
|
||||
;; (require 'erc-replace)
|
||||
;; (erc-replace-mode 1)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
|
||||
(defgroup erc-replace nil
|
||||
"Replace text from incoming messages"
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-replace-alist nil
|
||||
"Alist describing text to be replaced in incoming messages.
|
||||
This is useful for filters.
|
||||
|
||||
The alist has elements of the form (FROM . TO). FROM can be a regular
|
||||
expression or a variable, or any sexp, TO can be a string or a
|
||||
function to call, or any sexp. If a function, it will be called with
|
||||
one argument, the string to be replaced, and it should return a
|
||||
replacement string."
|
||||
:group 'erc-replace
|
||||
:type '(repeat (cons :tag "Search & Replace"
|
||||
(choice :tag "From"
|
||||
regexp
|
||||
variable
|
||||
sexp)
|
||||
(choice :tag "To"
|
||||
string
|
||||
function
|
||||
sexp))))
|
||||
|
||||
(defun erc-replace-insert ()
|
||||
"Function to run from `erc-insert-modify-hook'.
|
||||
It replaces text according to `erc-replace-alist'."
|
||||
(mapcar (lambda (elt)
|
||||
(goto-char (point-min))
|
||||
(let ((from (car elt))
|
||||
(to (cdr elt)))
|
||||
(unless (stringp from)
|
||||
(setq from (eval from)))
|
||||
(while (re-search-forward from nil t)
|
||||
(cond ((stringp to)
|
||||
(replace-match to))
|
||||
((and (symbolp to) (fboundp to))
|
||||
(replace-match (funcall to (match-string 0))))
|
||||
(t
|
||||
(eval to))))))
|
||||
erc-replace-alist))
|
||||
|
||||
;;;###autoload (autoload 'erc-replace-mode "erc-replace")
|
||||
(define-erc-module replace nil
|
||||
"This mode replaces incoming text according to `erc-replace-alist'."
|
||||
((add-hook 'erc-insert-modify-hook
|
||||
'erc-replace-insert))
|
||||
((remove-hook 'erc-insert-modify-hook
|
||||
'erc-replace-insert)))
|
||||
|
||||
(provide 'erc-replace)
|
||||
|
||||
;; arch-tag: dd904a59-d8a6-47f8-ac3a-76b698289a18
|
||||
;;; erc-replace.el ends here
|
||||
148
lisp/erc/erc-ring.el
Normal file
148
lisp/erc/erc-ring.el
Normal file
|
|
@ -0,0 +1,148 @@
|
|||
;; erc-ring.el -- Command history handling for erc using ring.el
|
||||
|
||||
;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Alex Schroeder <alex@gnu.org>
|
||||
;; Keywords: comm
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcHistory
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file implements an input ring -- a history of the stuff you
|
||||
;; wrote. To activate:
|
||||
;;
|
||||
;; (require 'erc-auto) or (require 'erc-ring)
|
||||
;; (erc-ring-mode 1)
|
||||
;;
|
||||
;; Use M-n and M-p to navigate the ring
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'comint)
|
||||
(require 'ring)
|
||||
|
||||
;;;###autoload (autoload 'erc-ring-mode "erc-ring" nil t)
|
||||
(define-erc-module ring nil
|
||||
"Stores input in a ring so that previous commands and messages can
|
||||
be recalled using M-p and M-n."
|
||||
((add-hook 'erc-send-pre-hook 'erc-add-to-input-ring)
|
||||
(define-key erc-mode-map "\M-p" 'erc-previous-command)
|
||||
(define-key erc-mode-map "\M-n" 'erc-next-command))
|
||||
((remove-hook 'erc-send-pre-hook 'erc-add-to-input-ring)
|
||||
(define-key erc-mode-map "\M-p" 'undefined)
|
||||
(define-key erc-mode-map "\M-n" 'undefined)))
|
||||
|
||||
(defvar erc-input-ring nil "Input ring for erc.")
|
||||
(make-variable-buffer-local 'erc-input-ring)
|
||||
|
||||
(defvar erc-input-ring-index nil
|
||||
"Position in the input ring for erc.
|
||||
If nil, the input line is blank and the user is conceptually 'after'
|
||||
the most recently added item in the ring. If an integer, the input
|
||||
line is non-blank and displays the item from the ring indexed by this
|
||||
variable.")
|
||||
(make-variable-buffer-local 'erc-input-ring-index)
|
||||
|
||||
(defun erc-input-ring-setup ()
|
||||
"Do the setup required so that we can use comint style input rings.
|
||||
Call this function when setting up the mode."
|
||||
(setq erc-input-ring (make-ring comint-input-ring-size))
|
||||
(setq erc-input-ring-index nil))
|
||||
|
||||
(defun erc-add-to-input-ring (s)
|
||||
"Add string S to the input ring and reset history position."
|
||||
(unless erc-input-ring (erc-input-ring-setup))
|
||||
(ring-insert erc-input-ring s)
|
||||
(setq erc-input-ring-index nil))
|
||||
|
||||
(defun erc-clear-input-ring ()
|
||||
"Remove all entries from the input ring, then call garbage-collect.
|
||||
You might use this for security purposes if you have typed a command
|
||||
containing a password."
|
||||
(interactive)
|
||||
(setq erc-input-ring (make-ring comint-input-ring-size)
|
||||
erc-input-ring-index nil)
|
||||
(garbage-collect)
|
||||
(message "ERC input ring cleared."))
|
||||
|
||||
(defun erc-previous-command ()
|
||||
"Replace current command with the previous one from the history."
|
||||
(interactive)
|
||||
(unless erc-input-ring (erc-input-ring-setup))
|
||||
;; if the ring isn't empty
|
||||
(when (> (ring-length erc-input-ring) 0)
|
||||
(if (and erc-input-ring-index
|
||||
(= (ring-length erc-input-ring) (1+ erc-input-ring-index)))
|
||||
(progn
|
||||
(erc-replace-current-command "")
|
||||
(setq erc-input-ring-index nil))
|
||||
|
||||
;; If we are not viewing old input and there's text in the input
|
||||
;; area, push it on the history ring before moving back through
|
||||
;; the input history, so it will be there when we return to the
|
||||
;; front.
|
||||
(if (null erc-input-ring-index)
|
||||
(when (> (point-max) erc-input-marker)
|
||||
(erc-add-to-input-ring (buffer-substring erc-input-marker
|
||||
(point-max)))
|
||||
(setq erc-input-ring-index 0)))
|
||||
|
||||
(setq erc-input-ring-index (if erc-input-ring-index
|
||||
(ring-plus1 erc-input-ring-index
|
||||
(ring-length erc-input-ring))
|
||||
0))
|
||||
(erc-replace-current-command (ring-ref erc-input-ring
|
||||
erc-input-ring-index)))))
|
||||
|
||||
(defun erc-next-command ()
|
||||
"Replace current command with the next one from the history."
|
||||
(interactive)
|
||||
(unless erc-input-ring (erc-input-ring-setup))
|
||||
;; if the ring isn't empty
|
||||
(when (> (ring-length erc-input-ring) 0)
|
||||
(if (and erc-input-ring-index
|
||||
(= 0 erc-input-ring-index))
|
||||
(progn
|
||||
(erc-replace-current-command "")
|
||||
(setq erc-input-ring-index nil))
|
||||
(setq erc-input-ring-index (ring-minus1 (or erc-input-ring-index 0)
|
||||
(ring-length erc-input-ring)))
|
||||
(erc-replace-current-command (ring-ref erc-input-ring
|
||||
erc-input-ring-index)))))
|
||||
|
||||
|
||||
(defun erc-replace-current-command (s)
|
||||
"Replace current command with string S."
|
||||
;; delete line
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region
|
||||
(progn (goto-char erc-insert-marker) (erc-bol))
|
||||
(goto-char (point-max)))
|
||||
(insert s)))
|
||||
|
||||
(provide 'erc-ring)
|
||||
|
||||
;;; erc-ring.el ends here
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: b77924a8-a80e-489d-84cd-b351761ea5c8
|
||||
149
lisp/erc/erc-sound.el
Normal file
149
lisp/erc/erc-sound.el
Normal file
|
|
@ -0,0 +1,149 @@
|
|||
;;; erc-sound.el --- CTCP SOUND support for ERC
|
||||
|
||||
;; Copyright (C) 2002, 2003 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 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:
|
||||
|
||||
;; This used to be in erc.el, I (Jorgen) just extracted it from there
|
||||
;; and put it in this file. Bugs and features are those of the
|
||||
;; original author.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
|
||||
;;;###autoload (autoload 'erc-sound-mode "erc-sound")
|
||||
(define-erc-module sound ctcp-sound
|
||||
"In ERC sound mode, the client will respond to CTCP SOUND requests
|
||||
and play sound files as requested."
|
||||
;; Enable:
|
||||
((define-key erc-mode-map "\C-c\C-s" 'erc-toggle-sound))
|
||||
;; Disable:
|
||||
((define-key erc-mode-map "\C-c\C-s" 'undefined)))
|
||||
|
||||
(erc-define-catalog-entry 'english 'CTCP-SOUND "%n (%u@%h) plays %s:%m")
|
||||
|
||||
(defgroup erc-sound nil
|
||||
"Make ERC play bells and whistles while chatting with people."
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-play-sound t
|
||||
"*Play sound on SOUND ctcp requests (used in ICQ chat)."
|
||||
:group 'erc-sound
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-sound-path nil
|
||||
"List of directories that contain sound samples to play on SOUND events."
|
||||
:group 'erc-sound
|
||||
:type '(repeat directory))
|
||||
|
||||
(defcustom erc-default-sound nil
|
||||
"Play this sound if the requested file was not found."
|
||||
:group 'erc-sound
|
||||
:type '(choice (const nil)
|
||||
file))
|
||||
|
||||
(defcustom erc-play-command "play"
|
||||
"Command for playing sound samples."
|
||||
:group 'erc-sound
|
||||
:type 'string)
|
||||
|
||||
(defun erc-cmd-SOUND (line &optional force)
|
||||
"Play the sound given in LINE."
|
||||
(cond
|
||||
((string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*\\)?$" line)
|
||||
(let ((file (match-string 1 line))
|
||||
(msg (match-string 2 line))
|
||||
(tgt (erc-default-target)))
|
||||
(if (null msg)
|
||||
(setq msg "")
|
||||
;; remove the first white space
|
||||
(setq msg (substring msg 1)))
|
||||
(if tgt
|
||||
(progn
|
||||
(erc-send-ctcp-message tgt (format "SOUND %s %s" file msg) force)
|
||||
(if erc-play-sound (erc-play-sound file)))
|
||||
(erc-display-message nil 'error (current-buffer) 'no-target))
|
||||
t))
|
||||
(t nil)))
|
||||
|
||||
(defvar erc-ctcp-query-SOUND-hook '(erc-ctcp-query-SOUND))
|
||||
(defun erc-ctcp-query-SOUND (proc nick login host to msg)
|
||||
(when (string-match "^SOUND\\s-+\\(\\S-+\\)\\(\\(\\s-+.*\\)\\|\\(\\s-*\\)\\)$" msg)
|
||||
(let ((sound (match-string 1 msg))
|
||||
(comment (match-string 2 msg)))
|
||||
(when erc-play-sound (erc-play-sound sound))
|
||||
(erc-display-message
|
||||
nil 'notice nil
|
||||
'CTCP-SOUND ?n nick ?u login ?h host ?s sound ?m comment)))
|
||||
nil)
|
||||
|
||||
(defun erc-play-sound (file)
|
||||
"Plays a sound file located in one of the directories in `erc-sound-path'
|
||||
with a command `erc-play-command'."
|
||||
(let ((filepath (erc-find-file file erc-sound-path)))
|
||||
(if (and (not filepath) erc-default-sound)
|
||||
(setq filepath erc-default-sound))
|
||||
(cond ((and filepath (file-exists-p filepath))
|
||||
(if (and (fboundp 'device-sound-enabled-p)
|
||||
(device-sound-enabled-p))
|
||||
; For XEmacs
|
||||
(play-sound-file filepath)
|
||||
; (start-process "erc-sound" nil erc-play-command filepath)
|
||||
(start-process "erc-sound" nil "/bin/tcsh" "-c"
|
||||
(concat erc-play-command " " filepath))))
|
||||
(t (beep)))
|
||||
(erc-log (format "Playing sound file %S" filepath))))
|
||||
|
||||
;(defun erc-play-sound (file)
|
||||
; "Plays a sound file located in one of the directories in `erc-sound-path'
|
||||
; with a command `erc-play-command'."
|
||||
; (let ((filepath nil)
|
||||
; (paths erc-sound-path))
|
||||
; (while (and paths
|
||||
; (progn (setq filepath (expand-file-name file (car paths)))
|
||||
; (not (file-exists-p filepath))))
|
||||
; (setq paths (cdr paths)))
|
||||
; (if (and (not (and filepath (file-exists-p filepath)))
|
||||
; erc-default-sound)
|
||||
; (setq filepath erc-default-sound))
|
||||
; (cond ((and filepath (file-exists-p filepath))
|
||||
;; (start-process "erc-sound" nil erc-play-command filepath)
|
||||
; (start-process "erc-sound" nil "/bin/tcsh" "-c"
|
||||
; (concat erc-play-command " " filepath))
|
||||
; )
|
||||
; (t (beep)))
|
||||
; (erc-log (format "Playing sound file %S" filepath))))
|
||||
|
||||
(defun erc-toggle-sound (&optional arg)
|
||||
"Toggles playing sounds on and off. With positive argument,
|
||||
turns them on. With any other argument turns sounds off."
|
||||
(interactive "P")
|
||||
(cond ((and (numberp arg) (> arg 0))
|
||||
(setq erc-play-sound t))
|
||||
(arg (setq erc-play-sound nil))
|
||||
(t (setq erc-play-sound (not erc-play-sound))))
|
||||
(message "ERC sound is %s" (if erc-play-sound "ON" "OFF")))
|
||||
|
||||
|
||||
(provide 'erc-sound)
|
||||
|
||||
;; arch-tag: 53657d1d-007f-4a20-91c1-588e71cf0cee
|
||||
;;; erc-sound.el ends here
|
||||
370
lisp/erc/erc-speedbar.el
Normal file
370
lisp/erc/erc-speedbar.el
Normal file
|
|
@ -0,0 +1,370 @@
|
|||
;;; erc-speedbar.el --- Speedbar support for ERC
|
||||
|
||||
;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
;; Contributor: Eric M. Ludlam <eric@siege-engine.com>
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; 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 provides integration of ERC into the Speedbar.
|
||||
|
||||
;;; TODO / ideas:
|
||||
|
||||
;; * Write intelligent update function:
|
||||
;; update-channel, update-nick, remove-nick-from-channel, ...
|
||||
;; * Use indicator-strings for op/voice
|
||||
;; * Extract/convert face notes field from bbdb if available and show
|
||||
;; it using sb-image.el
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'speedbar)
|
||||
(condition-case nil (require 'dframe) (error nil))
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;;; Customization:
|
||||
|
||||
(defgroup erc-speedbar nil
|
||||
"Integration of ERC in the Speedbar"
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-speedbar-sort-users-type 'activity
|
||||
"How channel nicknames are sorted.
|
||||
|
||||
'activity - Sort users by channel activity
|
||||
'alphabetical - Sort users alphabetically
|
||||
nil - Do not sort users"
|
||||
:group 'erc-speedbar
|
||||
:type '(choice (const :tag "Sort users by channel activity" activity)
|
||||
(const :tag "Sort users alphabetically" alphabetical)
|
||||
(const :tag "Do not sort users" nil)))
|
||||
|
||||
(defvar erc-speedbar-key-map nil
|
||||
"Keymap used when in erc display mode.")
|
||||
|
||||
(defun erc-install-speedbar-variables ()
|
||||
"Install those variables used by speedbar to enhance ERC."
|
||||
(if erc-speedbar-key-map
|
||||
nil
|
||||
(setq erc-speedbar-key-map (speedbar-make-specialized-keymap))
|
||||
|
||||
;; Basic tree features
|
||||
(define-key erc-speedbar-key-map "e" 'speedbar-edit-line)
|
||||
(define-key erc-speedbar-key-map "\C-m" 'speedbar-edit-line)
|
||||
(define-key erc-speedbar-key-map "+" 'speedbar-expand-line)
|
||||
(define-key erc-speedbar-key-map "=" 'speedbar-expand-line)
|
||||
(define-key erc-speedbar-key-map "-" 'speedbar-contract-line))
|
||||
|
||||
(speedbar-add-expansion-list '("ERC" erc-speedbar-menu-items
|
||||
erc-speedbar-key-map
|
||||
erc-speedbar-server-buttons))
|
||||
(speedbar-add-mode-functions-list
|
||||
'("ERC" (speedbar-item-info . erc-speedbar-item-info))))
|
||||
|
||||
(defvar erc-speedbar-menu-items
|
||||
'(["Goto buffer" speedbar-edit-line t]
|
||||
["Expand Node" speedbar-expand-line
|
||||
(save-excursion (beginning-of-line)
|
||||
(looking-at "[0-9]+: *.\\+. "))]
|
||||
["Contract Node" speedbar-contract-line
|
||||
(save-excursion (beginning-of-line)
|
||||
(looking-at "[0-9]+: *.-. "))])
|
||||
"Additional menu-items to add to speedbar frame.")
|
||||
|
||||
;; Make sure our special speedbar major mode is loaded
|
||||
(if (featurep 'speedbar)
|
||||
(erc-install-speedbar-variables)
|
||||
(add-hook 'speedbar-load-hook 'erc-install-speedbar-variables))
|
||||
|
||||
;;; ERC hierarchy display method
|
||||
;;;###autoload
|
||||
(defun erc-speedbar-browser ()
|
||||
"Initialize speedbar to display an ERC browser.
|
||||
This will add a speedbar major display mode."
|
||||
(interactive)
|
||||
(require 'speedbar)
|
||||
;; Make sure that speedbar is active
|
||||
(speedbar-frame-mode 1)
|
||||
;; Now, throw us into Info mode on speedbar.
|
||||
(speedbar-change-initial-expansion-list "ERC")
|
||||
(speedbar-get-focus))
|
||||
|
||||
(defun erc-speedbar-buttons (buffer)
|
||||
"Create buttons for speedbar in BUFFER."
|
||||
(erase-buffer)
|
||||
(let (serverp chanp queryp)
|
||||
(with-current-buffer buffer
|
||||
(setq serverp (eq buffer (process-buffer erc-server-process)))
|
||||
(setq chanp (erc-channel-p (erc-default-target)))
|
||||
(setq queryp (erc-query-buffer-p)))
|
||||
(cond (serverp
|
||||
(erc-speedbar-channel-buttons nil 0 buffer))
|
||||
(chanp
|
||||
(erc-speedbar-insert-target buffer 0)
|
||||
(forward-line -1)
|
||||
(erc-speedbar-expand-channel "+" buffer 0))
|
||||
(queryp
|
||||
(erc-speedbar-insert-target buffer 0))
|
||||
(t (ignore)))))
|
||||
|
||||
(defun erc-speedbar-server-buttons (directory depth)
|
||||
"Insert the initial list of servers you are connected to."
|
||||
(let ((servers (erc-buffer-list
|
||||
(lambda ()
|
||||
(eq (current-buffer)
|
||||
(process-buffer erc-server-process))))))
|
||||
(when servers
|
||||
(speedbar-with-writable
|
||||
(dolist (server servers)
|
||||
(speedbar-make-tag-line
|
||||
'bracket ?+ 'erc-speedbar-expand-server server
|
||||
(buffer-name server) 'erc-speedbar-goto-buffer server nil
|
||||
depth))
|
||||
t))))
|
||||
|
||||
(defun erc-speedbar-expand-server (text server indent)
|
||||
(cond ((string-match "+" text)
|
||||
(speedbar-change-expand-button-char ?-)
|
||||
(if (speedbar-with-writable
|
||||
(save-excursion
|
||||
(end-of-line) (forward-char 1)
|
||||
(erc-speedbar-channel-buttons nil (1+ indent) server)))
|
||||
(speedbar-change-expand-button-char ?-)
|
||||
(speedbar-change-expand-button-char ??)))
|
||||
((string-match "-" text) ;we have to contract this node
|
||||
(speedbar-change-expand-button-char ?+)
|
||||
(speedbar-delete-subblock indent))
|
||||
(t (error "Ooops... not sure what to do")))
|
||||
(speedbar-center-buffer-smartly))
|
||||
|
||||
(defun erc-speedbar-channel-buttons (directory depth server-buffer)
|
||||
(when (get-buffer server-buffer)
|
||||
(let* ((proc (with-current-buffer server-buffer erc-server-process))
|
||||
(targets (erc-buffer-list
|
||||
(lambda ()
|
||||
(not (eq (process-buffer erc-server-process)
|
||||
(current-buffer))))
|
||||
proc)))
|
||||
(when targets
|
||||
(speedbar-with-writable
|
||||
(dolist (target targets)
|
||||
(erc-speedbar-insert-target target depth))
|
||||
t)))))
|
||||
|
||||
(defun erc-speedbar-insert-target (buffer depth)
|
||||
(if (with-current-buffer buffer
|
||||
(erc-channel-p (erc-default-target)))
|
||||
(speedbar-make-tag-line
|
||||
'bracket ?+ 'erc-speedbar-expand-channel buffer
|
||||
(buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil
|
||||
depth)
|
||||
;; Query target
|
||||
(speedbar-make-tag-line
|
||||
nil nil nil nil
|
||||
(buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil
|
||||
depth)))
|
||||
|
||||
(defun erc-speedbar-expand-channel (text channel indent)
|
||||
"For the line matching TEXT, in CHANNEL, expand or contract a line.
|
||||
INDENT is the current indentation level."
|
||||
(cond
|
||||
((string-match "+" text)
|
||||
(speedbar-change-expand-button-char ?-)
|
||||
(speedbar-with-writable
|
||||
(save-excursion
|
||||
(end-of-line) (forward-char 1)
|
||||
(let ((modes (with-current-buffer channel
|
||||
(concat (apply 'concat
|
||||
erc-channel-modes)
|
||||
(cond
|
||||
((and erc-channel-user-limit
|
||||
erc-channel-key)
|
||||
(if erc-show-channel-key-p
|
||||
(format "lk %.0f %s"
|
||||
erc-channel-user-limit
|
||||
erc-channel-key)
|
||||
(format "kl %.0f" erc-channel-user-limit)))
|
||||
(erc-channel-user-limit
|
||||
;; Emacs has no bignums
|
||||
(format "l %.0f" erc-channel-user-limit))
|
||||
(erc-channel-key
|
||||
(if erc-show-channel-key-p
|
||||
(format "k %s" erc-channel-key)
|
||||
"k"))
|
||||
(t "")))))
|
||||
(topic (erc-controls-interpret
|
||||
(with-current-buffer channel erc-channel-topic))))
|
||||
(speedbar-make-tag-line
|
||||
'angle ?i nil nil
|
||||
(concat "Modes: +" modes) nil nil nil
|
||||
(1+ indent))
|
||||
(unless (string= topic "")
|
||||
(speedbar-make-tag-line
|
||||
'angle ?i nil nil
|
||||
(concat "Topic: " topic) nil nil nil
|
||||
(1+ indent)))
|
||||
(let ((names (cond ((eq erc-speedbar-sort-users-type 'alphabetical)
|
||||
(erc-sort-channel-users-alphabetically
|
||||
(with-current-buffer channel
|
||||
(erc-get-channel-user-list))))
|
||||
((eq erc-speedbar-sort-users-type 'activity)
|
||||
(erc-sort-channel-users-by-activity
|
||||
(with-current-buffer channel
|
||||
(erc-get-channel-user-list))))
|
||||
(t (with-current-buffer channel
|
||||
(erc-get-channel-user-list))))))
|
||||
(when names
|
||||
(speedbar-with-writable
|
||||
(dolist (entry names)
|
||||
(erc-speedbar-insert-user entry ?+ (1+ indent))))))))))
|
||||
((string-match "-" text)
|
||||
(speedbar-change-expand-button-char ?+)
|
||||
(speedbar-delete-subblock indent))
|
||||
(t (error "Ooops... not sure what to do")))
|
||||
(speedbar-center-buffer-smartly))
|
||||
|
||||
(defun erc-speedbar-insert-user (entry exp-char indent)
|
||||
"Insert one user based on the channel member list ENTRY.
|
||||
EXP-CHAR is the expansion character to use.
|
||||
INDENT is the current indentation level."
|
||||
(let* ((user (car entry))
|
||||
(cuser (cdr entry))
|
||||
(nick (erc-server-user-nickname user))
|
||||
(host (erc-server-user-host user))
|
||||
(info (erc-server-user-info user))
|
||||
(login (erc-server-user-login user))
|
||||
(name (erc-server-user-full-name user))
|
||||
(voice (and cuser (erc-channel-user-voice cuser)))
|
||||
(op (and cuser (erc-channel-user-op cuser)))
|
||||
(nick-str (concat (if op "@" "") (if voice "+" "") nick))
|
||||
(finger (concat login (when (or login host) "@") host))
|
||||
(sbtoken (list finger name info)))
|
||||
(if (or login host name info) ; we want to be expandable
|
||||
(speedbar-make-tag-line
|
||||
'bracket ?+ 'erc-speedbar-expand-user sbtoken
|
||||
nick-str nil sbtoken nil
|
||||
indent)
|
||||
(when (equal exp-char ?-)
|
||||
(forward-line -1)
|
||||
(erc-speedbar-expand-user "+" (list finger name info) indent))
|
||||
(speedbar-make-tag-line
|
||||
'statictag ?? nil nil
|
||||
nick-str nil nil nil
|
||||
indent))))
|
||||
|
||||
(defun erc-speedbar-update-channel (buffer)
|
||||
"Update the speedbar information about a ERC buffer. The update
|
||||
is only done when the channel is actually expanded already."
|
||||
;; This is only a rude hack and doesn't care about multiserver usage
|
||||
;; yet, consider this a brain storming, better ideas?
|
||||
(with-current-buffer speedbar-buffer
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward (concat "^1: *.+. *"
|
||||
(regexp-quote (buffer-name buffer)))
|
||||
nil t)
|
||||
(beginning-of-line)
|
||||
(speedbar-delete-subblock 1)
|
||||
(erc-speedbar-expand-channel "+" buffer 1)))))
|
||||
|
||||
(defun erc-speedbar-expand-user (text token indent)
|
||||
(cond ((string-match "+" text)
|
||||
(speedbar-change-expand-button-char ?-)
|
||||
(speedbar-with-writable
|
||||
(save-excursion
|
||||
(end-of-line) (forward-char 1)
|
||||
(let ((finger (nth 0 token))
|
||||
(name (nth 1 token))
|
||||
(info (nth 2 token)))
|
||||
(when finger
|
||||
(speedbar-make-tag-line
|
||||
nil nil nil nil
|
||||
finger nil nil nil
|
||||
(1+ indent)))
|
||||
(when name
|
||||
(speedbar-make-tag-line
|
||||
nil nil nil nil
|
||||
name nil nil nil
|
||||
(1+ indent)))
|
||||
(when info
|
||||
(speedbar-make-tag-line
|
||||
nil nil nil nil
|
||||
info nil nil nil
|
||||
(1+ indent)))))))
|
||||
((string-match "-" text)
|
||||
(speedbar-change-expand-button-char ?+)
|
||||
(speedbar-delete-subblock indent))
|
||||
(t (error "Ooops... not sure what to do")))
|
||||
(speedbar-center-buffer-smartly))
|
||||
|
||||
(defun erc-speedbar-goto-buffer (text buffer indent)
|
||||
"When user clicks on TEXT, goto an ERC buffer.
|
||||
The INDENT level is ignored."
|
||||
(if (featurep 'dframe)
|
||||
(progn
|
||||
(dframe-select-attached-frame speedbar-frame)
|
||||
(let ((bwin (get-buffer-window buffer 0)))
|
||||
(if bwin
|
||||
(progn
|
||||
(select-window bwin)
|
||||
(raise-frame (window-frame bwin)))
|
||||
(if dframe-power-click
|
||||
(let ((pop-up-frames t))
|
||||
(select-window (display-buffer buffer)))
|
||||
(dframe-select-attached-frame speedbar-frame)
|
||||
(switch-to-buffer buffer)))))
|
||||
(let ((bwin (get-buffer-window buffer 0)))
|
||||
(if bwin
|
||||
(progn
|
||||
(select-window bwin)
|
||||
(raise-frame (window-frame bwin)))
|
||||
(if speedbar-power-click
|
||||
(let ((pop-up-frames t)) (select-window (display-buffer buffer)))
|
||||
(dframe-select-attached-frame speedbar-frame)
|
||||
(switch-to-buffer buffer))))))
|
||||
|
||||
(defun erc-speedbar-line-text ()
|
||||
"Return the text for the item on the current line."
|
||||
(beginning-of-line)
|
||||
(when (re-search-forward "[]>] " nil t)
|
||||
(buffer-substring-no-properties (point) (point-at-eol))))
|
||||
|
||||
(defun erc-speedbar-item-info ()
|
||||
"Display information about the current buffer on the current line."
|
||||
(let ((data (speedbar-line-token))
|
||||
(txt (erc-speedbar-line-text)))
|
||||
(cond ((and data (listp data))
|
||||
(message "%s: %s" txt (car data)))
|
||||
((bufferp data)
|
||||
(message "Channel: %s" txt))
|
||||
(t
|
||||
(message "%s" txt)))))
|
||||
|
||||
(provide 'erc-speedbar)
|
||||
;;; erc-speedbar.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 7a6558a4-3308-4bf5-a284-e1d042c933c6
|
||||
93
lisp/erc/erc-spelling.el
Normal file
93
lisp/erc/erc-spelling.el
Normal file
|
|
@ -0,0 +1,93 @@
|
|||
;;; erc-spelling.el --- use flyspell in ERC
|
||||
|
||||
;; Copyright (C) 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Jorgen Schaefer <forcer@forcix.cx>
|
||||
;; Keywords: irc
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcSpelling
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This is an ERC module to enable flyspell mode in ERC buffers. This
|
||||
;; ensures correct behavior of flyspell, and even sets up a
|
||||
;; channel-local dictionary if so required.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'flyspell)
|
||||
|
||||
;;;###autoload (autoload 'erc-spelling-mode "erc-spelling" nil t)
|
||||
(define-erc-module spelling nil
|
||||
"Enable flyspell mode in ERC buffers."
|
||||
;; Use erc-connect-pre-hook instead of erc-mode-hook as pre-hook is
|
||||
;; called AFTER the server buffer is initialized.
|
||||
((add-hook 'erc-connect-pre-hook 'erc-spelling-init)
|
||||
(mapc (lambda (buffer)
|
||||
(with-current-buffer buffer (erc-spelling-init)))
|
||||
(erc-buffer-list)))
|
||||
((remove-hook 'erc-connect-pre-hook 'erc-spelling-init)
|
||||
(mapc (lambda (buffer)
|
||||
(with-current-buffer buffer (flyspell-mode 0)))
|
||||
(erc-buffer-list))))
|
||||
|
||||
(defcustom erc-spelling-dictionaries nil
|
||||
"An alist mapping buffer names to dictionaries.
|
||||
The `car' of every cell is a buffer name, the `cadr' is the
|
||||
string name of an associated dictionary.
|
||||
The dictionary is inherited from server buffers, so if you want a
|
||||
default dictionary for some server, you can use a server buffer
|
||||
name here."
|
||||
:type '(choice (const nil)
|
||||
(repeat (cons (string :tag "Buffer name")
|
||||
(string :tag "Dictionary"))))
|
||||
:group 'erc-spelling)
|
||||
|
||||
(defun erc-spelling-init ()
|
||||
"Enable flyspell mode in an ERC buffer."
|
||||
(let ((name (downcase (buffer-name)))
|
||||
(dicts erc-spelling-dictionaries))
|
||||
(while (and dicts
|
||||
(not (string= name (downcase (caar dicts)))))
|
||||
(setq dicts (cdr dicts)))
|
||||
(setq ispell-local-dictionary
|
||||
(if dicts
|
||||
(cadr (car dicts))
|
||||
(let ((server (erc-server-buffer)))
|
||||
(if server
|
||||
(with-current-buffer server
|
||||
ispell-local-dictionary)
|
||||
nil)))))
|
||||
(setq flyspell-generic-check-word-p 'erc-spelling-flyspell-verify)
|
||||
(flyspell-mode 1))
|
||||
|
||||
(put 'erc-mode
|
||||
'flyspell-mode-predicate
|
||||
'erc-spelling-flyspell-verify)
|
||||
|
||||
(defun erc-spelling-flyspell-verify ()
|
||||
"Flyspell only the input line, nothing else."
|
||||
(> (point)
|
||||
erc-input-marker))
|
||||
|
||||
(provide 'erc-spelling)
|
||||
|
||||
;; arch-tag: 04ae1c46-0fd1-4e1a-8b80-55bfa471c945
|
||||
;;; erc-spelling.el ends here
|
||||
341
lisp/erc/erc-stamp.el
Normal file
341
lisp/erc/erc-stamp.el
Normal file
|
|
@ -0,0 +1,341 @@
|
|||
;;; erc-stamp.el --- Timestamping for Emacs IRC CLient
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
;; Keywords: comm, processes, timestamp
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcStamp
|
||||
|
||||
;; 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:
|
||||
|
||||
;; The code contained in this module is responsible for inserting
|
||||
;; timestamps into ERC buffers. In order to actually activate this,
|
||||
;; you must call `erc-timestamp-mode'.
|
||||
|
||||
;; You can choose between two different ways of inserting timestamps.
|
||||
;; Customize `erc-insert-timestamp-function' and
|
||||
;; `erc-insert-away-timestamp-function'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(require 'erc-compat)
|
||||
|
||||
(defgroup erc-stamp nil
|
||||
"For long conversation on IRC it is sometimes quite
|
||||
useful to have individual messages timestamp. This
|
||||
group provides settings related to the format and display
|
||||
of timestamp information in `erc-mode' buffer.
|
||||
|
||||
For timestamping to be activated, you just need to load `erc-stamp'
|
||||
in your .emacs file or interactively using `load-library'."
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-timestamp-format "[%H:%M]"
|
||||
"*If set to a string, messages will be timestamped.
|
||||
This string is processed using `format-time-string'.
|
||||
Good examples are \"%T\" and \"%H:%M\".
|
||||
|
||||
If nil, timestamping is turned off."
|
||||
:group 'erc-stamp
|
||||
:type '(choice (const nil)
|
||||
(string)))
|
||||
|
||||
(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-right
|
||||
"*Function to use to insert timestamps.
|
||||
|
||||
It takes a single argument STRING which is the final string
|
||||
which all text-properties already appended. This function only cares about
|
||||
inserting this string at the right position. Narrowing is in effect
|
||||
while it is called, so (point-min) and (point-max) determine the region to
|
||||
operate on."
|
||||
:group 'erc-stamp
|
||||
:type '(choice (const :tag "Right" erc-insert-timestamp-right)
|
||||
(const :tag "Left" erc-insert-timestamp-left)
|
||||
function))
|
||||
|
||||
(defcustom erc-away-timestamp-format "<%H:%M>"
|
||||
"*Timestamp format used when marked as being away.
|
||||
|
||||
If nil, timestamping is turned off when away unless `erc-timestamp-format'
|
||||
is set.
|
||||
|
||||
If `erc-timestamp-format' is set, this will not be used."
|
||||
:group 'erc-stamp
|
||||
:type '(choice (const nil)
|
||||
(string)))
|
||||
|
||||
(defcustom erc-insert-away-timestamp-function 'erc-insert-timestamp-right
|
||||
"*Function to use to insert the away timestamp.
|
||||
|
||||
See `erc-insert-timestamp-function' for details."
|
||||
:group 'erc-stamp
|
||||
:type '(choice (const :tag "Right" erc-insert-timestamp-right)
|
||||
(const :tag "Left" erc-insert-timestamp-left)
|
||||
function))
|
||||
|
||||
(defcustom erc-hide-timestamps nil
|
||||
"*If non-nil, timestamps will be invisible.
|
||||
|
||||
This is useful for logging, because, although timestamps will be
|
||||
hidden, they will still be present in the logs."
|
||||
:group 'erc-stamp
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-echo-timestamps nil
|
||||
"*If non-nil, print timestamp in the minibuffer when point is moved.
|
||||
Using this variable, you can turn off normal timestamping,
|
||||
and simply move point to an irc message to see its timestamp
|
||||
printed in the minibuffer."
|
||||
:group 'erc-stamp
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-echo-timestamp-format "Timestamped %A, %H:%M:%S"
|
||||
"*Format string to be used when `erc-echo-timestamps' is non-nil.
|
||||
This string specifies the format of the timestamp being echoed in
|
||||
the minibuffer."
|
||||
:group 'erc-stamp
|
||||
:type 'string)
|
||||
|
||||
(defcustom erc-timestamp-intangible t
|
||||
"*Whether the timestamps should be intangible, i.e. prevent the point
|
||||
from entering them and instead jump over them."
|
||||
:group 'erc-stamp
|
||||
:type 'boolean)
|
||||
|
||||
(defface erc-timestamp-face '((t (:bold t :foreground "green")))
|
||||
"ERC timestamp face."
|
||||
:group 'erc-faces)
|
||||
|
||||
;;;###autoload (autoload 'erc-timestamp-mode "erc-stamp" nil t)
|
||||
(define-erc-module stamp timestamp
|
||||
"This mode timestamps messages in the channel buffers."
|
||||
((add-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
|
||||
(add-hook 'erc-insert-modify-hook 'erc-add-timestamp t)
|
||||
(add-hook 'erc-send-modify-hook 'erc-add-timestamp t))
|
||||
((remove-hook 'erc-mode-hook 'erc-munge-invisibility-spec)
|
||||
(remove-hook 'erc-insert-modify-hook 'erc-add-timestamp)
|
||||
(remove-hook 'erc-send-modify-hook 'erc-add-timestamp)))
|
||||
|
||||
(defun erc-add-timestamp ()
|
||||
"Add timestamp and text-properties to message.
|
||||
|
||||
This function is meant to be called from `erc-insert-modify-hook'
|
||||
or `erc-send-modify-hook'."
|
||||
(unless (get-text-property (point) 'invisible)
|
||||
(let ((ct (current-time)))
|
||||
(if (fboundp erc-insert-timestamp-function)
|
||||
(funcall erc-insert-timestamp-function
|
||||
(erc-format-timestamp ct erc-timestamp-format))
|
||||
(error "Timestamp function unbound"))
|
||||
(when (and (fboundp erc-insert-away-timestamp-function)
|
||||
erc-away-timestamp-format
|
||||
(with-current-buffer (erc-server-buffer) erc-away)
|
||||
(not erc-timestamp-format))
|
||||
(funcall erc-insert-away-timestamp-function
|
||||
(erc-format-timestamp ct erc-away-timestamp-format)))
|
||||
(add-text-properties (point-min) (point-max)
|
||||
(list 'timestamp ct))
|
||||
(add-text-properties (point-min) (point-max)
|
||||
(list 'point-entered 'erc-echo-timestamp)))))
|
||||
|
||||
(defvar erc-timestamp-last-inserted nil
|
||||
"Last timestamp inserted into the buffer.")
|
||||
(make-variable-buffer-local 'erc-timestamp-last-inserted)
|
||||
|
||||
(defcustom erc-timestamp-only-if-changed-flag t
|
||||
"*Insert timestamp only if its value changed since last insertion.
|
||||
If `erc-insert-timestamp-function' is `erc-insert-timestamp-left', a
|
||||
string of spaces which is the same size as the timestamp is added to
|
||||
the beginning of the line in its place. If you use
|
||||
`erc-insert-timestamp-right', nothing gets inserted in place of the
|
||||
timestamp."
|
||||
:group 'erc-stamp
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-timestamp-right-column nil
|
||||
"*If non-nil, the column at which the timestamp is inserted,
|
||||
if the timestamp is to be printed to the right. If nil,
|
||||
`erc-insert-timestamp-right' will use other means to determine
|
||||
the correct column."
|
||||
:group 'erc-stamp
|
||||
:type '(choice
|
||||
(integer :tag "Column number")
|
||||
(const :tag "Unspecified" nil)))
|
||||
|
||||
(defcustom erc-timestamp-right-align-by-pixel nil
|
||||
"*If non-nil, insert the right timestamp based on a pixel value.
|
||||
This is needed when variable-width text precedes a timestamp.
|
||||
Unfortunately, it only works in Emacs 22 and when using the X
|
||||
Window System."
|
||||
:group 'erc-stamp
|
||||
:type 'boolean)
|
||||
|
||||
(defun erc-insert-timestamp-left (string)
|
||||
"Insert timestamps at the beginning of the line."
|
||||
(goto-char (point-min))
|
||||
(let* ((ignore-p (and erc-timestamp-only-if-changed-flag
|
||||
(string-equal string erc-timestamp-last-inserted)))
|
||||
(len (length string))
|
||||
(s (if ignore-p (make-string len ? ) string)))
|
||||
(unless ignore-p (setq erc-timestamp-last-inserted string))
|
||||
(erc-put-text-property 0 len 'field 'erc-timestamp s)
|
||||
(insert s)))
|
||||
|
||||
(defun erc-insert-aligned (string pos &optional fallback)
|
||||
"Insert STRING based on a fraction of the width of the buffer.
|
||||
Fraction is roughly (/ POS (window-width)).
|
||||
|
||||
If `erc-timestamp-right-align-by-pixel' is nil, use
|
||||
\(- POS FALLBACK) to determine how many spaces to insert."
|
||||
(if (not erc-timestamp-right-align-by-pixel)
|
||||
(insert (make-string (- pos fallback) ? ) string)
|
||||
(insert " ")
|
||||
(let ((offset (floor (* (/ (1- pos) (window-width) 1.0)
|
||||
(nth 2 (window-inside-pixel-edges))))))
|
||||
(put-text-property (1- (point)) (point) 'display
|
||||
`(space :align-to (,offset))))
|
||||
(insert string)))
|
||||
|
||||
(defun erc-insert-timestamp-right (string)
|
||||
"Insert timestamp on the right side of the screen.
|
||||
STRING is the timestamp to insert. The function is a possible value
|
||||
for `erc-insert-timestamp-function'.
|
||||
|
||||
If `erc-timestamp-only-if-changed-flag' is nil, a timestamp is always
|
||||
printed. If this variable is non-nil, a timestamp is only printed if
|
||||
it is different from the last.
|
||||
|
||||
If `erc-timestamp-right-column' is set, its value will be used as the
|
||||
column at which the timestamp is to be printed. If it is nil, and
|
||||
`erc-fill-mode' is active, then the timestamp will be printed just
|
||||
before `erc-fill-column'. Otherwise, if the current buffer is
|
||||
shown in a window, that window's width is used. If the buffer is
|
||||
not shown, and `fill-column' is set, then the timestamp will be
|
||||
printed just `fill-column'. As a last resort, the timestamp will
|
||||
be printed just before the window-width."
|
||||
(unless (and erc-timestamp-only-if-changed-flag
|
||||
(string-equal string erc-timestamp-last-inserted))
|
||||
(setq erc-timestamp-last-inserted string)
|
||||
(goto-char (point-max))
|
||||
(forward-char -1);; before the last newline
|
||||
(let* ((current-window (get-buffer-window (current-buffer)))
|
||||
(pos (cond
|
||||
(erc-timestamp-right-column
|
||||
(+ erc-timestamp-right-column (length string)))
|
||||
((and (boundp 'erc-fill-mode)
|
||||
erc-fill-mode
|
||||
(boundp 'erc-fill-column))
|
||||
(1+ erc-fill-column))
|
||||
(current-window
|
||||
(- (window-width current-window)
|
||||
1))
|
||||
(fill-column
|
||||
(1+ fill-column))
|
||||
(t
|
||||
(- (window-width)
|
||||
1))))
|
||||
(from (point))
|
||||
(col (current-column))
|
||||
indent)
|
||||
;; deal with variable-width characters
|
||||
(setq pos (- pos (string-width string))
|
||||
;; the following is a kludge that works with most
|
||||
;; international input
|
||||
col (+ col (ceiling (/ (- col (- (point) (point-at-bol))) 1.6))))
|
||||
(if (< col pos)
|
||||
(erc-insert-aligned string pos col)
|
||||
(newline)
|
||||
(setq from (point))
|
||||
(indent-to pos)
|
||||
(insert string))
|
||||
(erc-put-text-property from (1+ (point)) 'field 'erc-timestamp)
|
||||
(erc-put-text-property from (1+ (point)) 'rear-nonsticky t)
|
||||
(when erc-timestamp-intangible
|
||||
(erc-put-text-property from (1+ (point)) 'intangible t)))))
|
||||
|
||||
;; for testing: (setq erc-timestamp-only-if-changed-flag nil)
|
||||
|
||||
(defun erc-format-timestamp (time format)
|
||||
"Return TIME formatted as string according to FORMAT.
|
||||
Return the empty string if FORMAT is nil."
|
||||
(if format
|
||||
(let ((ts (format-time-string format time)))
|
||||
(erc-put-text-property 0 (length ts) 'face 'erc-timestamp-face ts)
|
||||
(erc-put-text-property 0 (length ts) 'invisible 'timestamp ts)
|
||||
(erc-put-text-property 0 (length ts)
|
||||
'isearch-open-invisible 'timestamp ts)
|
||||
;; N.B. Later use categories instead of this harmless, but
|
||||
;; inelegant, hack. -- BPT
|
||||
(when erc-timestamp-intangible
|
||||
(erc-put-text-property 0 (length ts) 'intangible t ts))
|
||||
ts)
|
||||
""))
|
||||
|
||||
;; This function is used to munge `buffer-invisibility-spec to an
|
||||
;; appropriate value. Currently, it only handles timestamps, thus its
|
||||
;; location. If you add other features which affect invisibility,
|
||||
;; please modify this function and move it to a more appropriate
|
||||
;; location.
|
||||
(defun erc-munge-invisibility-spec ()
|
||||
(if erc-hide-timestamps
|
||||
(setq buffer-invisibility-spec
|
||||
(if (listp buffer-invisibility-spec)
|
||||
(cons 'timestamp buffer-invisibility-spec)
|
||||
(list 't 'timestamp)))
|
||||
(setq buffer-invisibility-spec
|
||||
(if (listp buffer-invisibility-spec)
|
||||
(remove 'timestamp buffer-invisibility-spec)
|
||||
(list 't)))))
|
||||
|
||||
(defun erc-hide-timestamps ()
|
||||
"Hide timestamp information from display."
|
||||
(interactive)
|
||||
(setq erc-hide-timestamps t)
|
||||
(erc-munge-invisibility-spec))
|
||||
|
||||
(defun erc-show-timestamps ()
|
||||
"Show timestamp information on display.
|
||||
This function only works if `erc-timestamp-format' was previously
|
||||
set, and timestamping is already active."
|
||||
(interactive)
|
||||
(setq erc-hide-timestamps nil)
|
||||
(erc-munge-invisibility-spec))
|
||||
|
||||
(defun erc-echo-timestamp (before now)
|
||||
"Print timestamp text-property of an IRC message.
|
||||
Argument BEFORE is where point was before it got moved and
|
||||
NOW is position of point currently."
|
||||
(when erc-echo-timestamps
|
||||
(let ((stamp (get-text-property now 'timestamp)))
|
||||
(when stamp
|
||||
(message (format-time-string erc-echo-timestamp-format
|
||||
stamp))))))
|
||||
|
||||
(provide 'erc-stamp)
|
||||
|
||||
;;; erc-stamp.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 9f6d31bf-61ba-45c5-bdbf-56331486ea27
|
||||
839
lisp/erc/erc-track.el
Normal file
839
lisp/erc/erc-track.el
Normal file
|
|
@ -0,0 +1,839 @@
|
|||
;;; erc-track.el --- Track modified channel buffers
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
;; Keywords: comm, faces
|
||||
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?ErcChannelTracking
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Highlights keywords and pals (friends), and hides or highlights fools
|
||||
;; (using a dark color). Add to your ~/.emacs:
|
||||
|
||||
;; (require 'erc-track)
|
||||
;; (erc-track-mode 1)
|
||||
|
||||
;; Todo:
|
||||
;; * Add extensibility so that custom functions can track
|
||||
;; custom modification types.
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(require 'erc)
|
||||
(require 'erc-compat)
|
||||
(require 'erc-match)
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup erc-track nil
|
||||
"Track active buffers and show activity in the modeline."
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-track-visibility t
|
||||
"Where do we look for buffers to determine their visibility?
|
||||
The value of this variable determines, when a buffer is considered
|
||||
visible or invisible. New messages in invisible buffers are tracked,
|
||||
while switching to visible buffers when they are tracked removes them
|
||||
from the list. See also `erc-track-when-inactive-mode'.
|
||||
|
||||
Possible values are:
|
||||
|
||||
t - all frames
|
||||
visible - all visible frames
|
||||
nil - only the selected frame
|
||||
selected-visible - only the selected frame if it is visible
|
||||
|
||||
Activity means that there was no user input in the last 10 seconds."
|
||||
:group 'erc-track
|
||||
:type '(choice (const :tag "All frames" t)
|
||||
(const :tag "All visible frames" visible)
|
||||
(const :tag "Only the selected frame" nil)
|
||||
(const :tag "Only the selected frame if it was active"
|
||||
active)))
|
||||
|
||||
(defcustom erc-track-exclude nil
|
||||
"A list targets (channel names or query targets) which should not be tracked."
|
||||
:group 'erc-track
|
||||
:type '(repeat string))
|
||||
|
||||
(defcustom erc-track-exclude-types '("NICK")
|
||||
"*List of message types to be ignored.
|
||||
This list could look like '(\"JOIN\" \"PART\")."
|
||||
:group 'erc-track
|
||||
:type 'erc-message-type)
|
||||
|
||||
(defcustom erc-track-exclude-server-buffer nil
|
||||
"*If true, don't perform tracking on the server buffer; this is
|
||||
useful for excluding all the things like MOTDs from the server and
|
||||
other miscellaneous functions."
|
||||
:group 'erc-track
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-track-shorten-start 1
|
||||
"This number specifies the minimum number of characters a channel name in
|
||||
the mode-line should be reduced to."
|
||||
:group 'erc-track
|
||||
:type 'number)
|
||||
|
||||
(defcustom erc-track-shorten-cutoff 4
|
||||
"All channel names longer than this value will be shortened."
|
||||
:group 'erc-track
|
||||
:type 'number)
|
||||
|
||||
(defcustom erc-track-shorten-aggressively nil
|
||||
"*If non-nil, channel names will be shortened more aggressively.
|
||||
Usually, names are not shortened if this will save only one character.
|
||||
Example: If there are two channels, #linux-de and #linux-fr, then
|
||||
normally these will not be shortened. When shortening aggressively,
|
||||
however, these will be shortened to #linux-d and #linux-f.
|
||||
|
||||
If this variable is set to `max', then channel names will be shortened
|
||||
to the max. Usually, shortened channel names will remain unique for a
|
||||
given set of existing channels. When shortening to the max, the shortened
|
||||
channel names will be unique for the set of active channels only.
|
||||
Example: If there are tow active channels #emacs and #vi, and two inactive
|
||||
channels #electronica and #folk, then usually the active channels are
|
||||
shortened to #em and #v. When shortening to the max, however, #emacs is
|
||||
not compared to #electronica -- only to #vi, therefore it can be shortened
|
||||
even more and the result is #e and #v.
|
||||
|
||||
This setting is used by `erc-track-shorten-names'."
|
||||
:group 'erc-track
|
||||
:type '(choice (const :tag "No" nil)
|
||||
(const :tag "Yes" t)
|
||||
(const :tag "Max" max)))
|
||||
|
||||
(defcustom erc-track-shorten-function 'erc-track-shorten-names
|
||||
"*This function will be used to reduce the channel names before display.
|
||||
It takes one argument, CHANNEL-NAMES which is a list of strings.
|
||||
It should return a list of strings of the same number of elements.
|
||||
If nil instead of a function, shortening is disabled."
|
||||
:group 'erc-track
|
||||
:type '(choice (const :tag "Disabled")
|
||||
function))
|
||||
|
||||
(defcustom erc-track-use-faces t
|
||||
"*Use faces in the mode-line.
|
||||
The faces used are the same as used for text in the buffers.
|
||||
\(e.g. `erc-pal-face' is used if a pal sent a message to that channel.)"
|
||||
:group 'erc-track
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-track-faces-priority-list
|
||||
'(erc-error-face erc-current-nick-face erc-keyword-face erc-pal-face
|
||||
erc-nick-msg-face erc-direct-msg-face erc-button erc-dangerous-host-face
|
||||
erc-default-face erc-action-face erc-nick-default-face erc-fool-face
|
||||
erc-notice-face erc-input-face erc-prompt-face)
|
||||
"A list of faces used to highlight active buffer names in the modeline.
|
||||
If a message contains one of the faces in this list, the buffer name will
|
||||
be highlighted using that face. The first matching face is used."
|
||||
:group 'erc-track
|
||||
:type '(repeat face))
|
||||
|
||||
(defcustom erc-track-priority-faces-only nil
|
||||
"Only track text highlighted with a priority face.
|
||||
If you would like to ignore changes in certain channels where there
|
||||
are no faces corresponding to your `erc-track-faces-priority-list', set
|
||||
this variable. You can set a list of channel name strings, so those
|
||||
will be ignored while all other channels will be tracked as normal.
|
||||
Other options are 'all, to apply this to all channels or nil, to disable
|
||||
this feature.
|
||||
Note: If you have a lot of faces listed in `erc-track-faces-priority-list',
|
||||
setting this variable might not be very useful."
|
||||
:group 'erc-track
|
||||
:type '(choice (const nil)
|
||||
(repeat string)
|
||||
(const all)))
|
||||
|
||||
(defcustom erc-track-position-in-mode-line 'before-modes
|
||||
"Where to show modified channel information in the mode-line.
|
||||
|
||||
Setting this variable only has effects in GNU Emacs versions above 21.3.
|
||||
|
||||
Choices are:
|
||||
'before-modes - add to the beginning of `mode-line-modes'
|
||||
'after-modes - add to the end of `mode-line-modes'
|
||||
|
||||
Any other value means add to the end of `global-mode-string'."
|
||||
:group 'erc-track
|
||||
:type '(choice (const :tag "Just before mode information" before-modes)
|
||||
(const :tag "Just after mode information" after-modes)
|
||||
(const :tag "After all other information" nil))
|
||||
:set (lambda (sym val)
|
||||
(set sym val)
|
||||
(when (and (boundp 'erc-track-mode)
|
||||
erc-track-mode)
|
||||
(erc-track-remove-from-mode-line)
|
||||
(erc-track-add-to-mode-line val))))
|
||||
|
||||
(defun erc-modified-channels-object (strings)
|
||||
"Generate a new `erc-modified-channels-object' based on STRINGS.
|
||||
If STRINGS is nil, we initialize `erc-modified-channels-object' to
|
||||
an appropriate initial value for this flavor of Emacs."
|
||||
(if strings
|
||||
(if (featurep 'xemacs)
|
||||
(let ((e-m-c-s '("[")))
|
||||
(push (cons (extent-at 0 (car strings)) (car strings))
|
||||
e-m-c-s)
|
||||
(dolist (string (cdr strings))
|
||||
(push "," e-m-c-s)
|
||||
(push (cons (extent-at 0 string) string)
|
||||
e-m-c-s))
|
||||
(push "] " e-m-c-s)
|
||||
(reverse e-m-c-s))
|
||||
(concat (if (eq erc-track-position-in-mode-line 'after-modes)
|
||||
"[" " [")
|
||||
(mapconcat 'identity (nreverse strings) ",")
|
||||
(if (eq erc-track-position-in-mode-line 'before-modes)
|
||||
"] " "]")))
|
||||
(if (featurep 'xemacs) '() "")))
|
||||
|
||||
(defvar erc-modified-channels-object (erc-modified-channels-object nil)
|
||||
"Internal object used for displaying modified channels in the mode line.")
|
||||
|
||||
(put 'erc-modified-channels-object 'risky-local-variable t); allow properties
|
||||
|
||||
(defvar erc-modified-channels-alist nil
|
||||
"An ALIST used for tracking channel modification activity.
|
||||
Each element looks like (BUFFER COUNT FACE) where BUFFER is a buffer
|
||||
object of the channel the entry corresponds to, COUNT is a number
|
||||
indicating how often activity was noticed, and FACE is the face to use
|
||||
when displaying the buffer's name. See `erc-track-faces-priority-list',
|
||||
and `erc-track-showcount'.
|
||||
|
||||
Entries in this list should only happen for buffers where activity occurred
|
||||
while the buffer was not visible.")
|
||||
|
||||
(defcustom erc-track-showcount nil
|
||||
"If non-nil, count of unseen messages will be shown for each channel."
|
||||
:type 'boolean
|
||||
:group 'erc-track)
|
||||
|
||||
(defcustom erc-track-showcount-string ":"
|
||||
"The string to display between buffer name and the count in the mode line.
|
||||
The default is a colon, resulting in \"#emacs:9\"."
|
||||
:type 'string
|
||||
:group 'erc-track)
|
||||
|
||||
(defcustom erc-track-switch-from-erc t
|
||||
"If non-nil, `erc-track-switch-buffer' will return to the last non-erc buffer
|
||||
when there are no more active channels."
|
||||
:type 'boolean
|
||||
:group 'erc-track)
|
||||
|
||||
(defcustom erc-track-switch-direction 'oldest
|
||||
"Direction `erc-track-switch-buffer' should switch.
|
||||
|
||||
oldest - find oldest active buffer
|
||||
newest - find newest active buffer
|
||||
leastactive - find buffer with least unseen messages
|
||||
mostactive - find buffer with most unseen messages."
|
||||
:group 'erc-track
|
||||
:type '(choice (const oldest)
|
||||
(const newest)
|
||||
(const leastactive)
|
||||
(const mostactive)))
|
||||
|
||||
|
||||
(defun erc-track-remove-from-mode-line ()
|
||||
"Remove `erc-track-modified-channels' from the mode-line"
|
||||
(when (boundp 'mode-line-modes)
|
||||
(setq mode-line-modes
|
||||
(remove '(t erc-modified-channels-object) mode-line-modes)))
|
||||
(when (consp global-mode-string)
|
||||
(setq global-mode-string
|
||||
(delq 'erc-modified-channels-object global-mode-string))))
|
||||
|
||||
(defun erc-track-add-to-mode-line (position)
|
||||
"Add `erc-track-modified-channels' to POSITION in the mode-line.
|
||||
See `erc-track-position-in-mode-line' for possible values."
|
||||
;; CVS Emacs has a new format string, and global-mode-string
|
||||
;; is very far to the right.
|
||||
(cond ((and (eq position 'before-modes)
|
||||
(boundp 'mode-line-modes))
|
||||
(add-to-list 'mode-line-modes
|
||||
'(t erc-modified-channels-object)))
|
||||
((and (eq position 'after-modes)
|
||||
(boundp 'mode-line-modes))
|
||||
(add-to-list 'mode-line-modes
|
||||
'(t erc-modified-channels-object) t))
|
||||
(t
|
||||
(when (not global-mode-string)
|
||||
(setq global-mode-string '(""))) ; Padding for mode-line wart
|
||||
(add-to-list 'global-mode-string
|
||||
'erc-modified-channels-object
|
||||
t))))
|
||||
|
||||
;;; Shortening of names
|
||||
|
||||
(defun erc-track-shorten-names (channel-names)
|
||||
"Call `erc-unique-channel-names' with the correct parameters.
|
||||
This function is a good value for `erc-track-shorten-function'.
|
||||
The list of all channels is returned by `erc-all-buffer-names'.
|
||||
CHANNEL-NAMES is the list of active channel names.
|
||||
Only channel names longer than `erc-track-shorten-cutoff' are
|
||||
actually shortened, and they are only shortened to a minimum
|
||||
of `erc-track-shorten-start' characters."
|
||||
(erc-unique-channel-names
|
||||
(erc-all-buffer-names)
|
||||
channel-names
|
||||
(lambda (s)
|
||||
(> (length s) erc-track-shorten-cutoff))
|
||||
erc-track-shorten-start))
|
||||
|
||||
(defvar erc-default-recipients)
|
||||
|
||||
(defun erc-all-buffer-names ()
|
||||
"Return all channel or query buffer names.
|
||||
Note that we cannot use `erc-channel-list' with a nil argument,
|
||||
because that does not return query buffers."
|
||||
(save-excursion
|
||||
(let (result)
|
||||
(dolist (buf (buffer-list))
|
||||
(set-buffer buf)
|
||||
(when (or (eq major-mode 'erc-mode) (eq major-mode 'erc-dcc-chat-mode))
|
||||
(setq result (cons (buffer-name) result))))
|
||||
result)))
|
||||
|
||||
(defun erc-unique-channel-names (all active &optional predicate start)
|
||||
"Return a list of unique channel names.
|
||||
ALL is the list of all channel and query buffer names.
|
||||
ACTIVE is the list of active buffer names.
|
||||
PREDICATE is a predicate that should return non-nil if a name needs
|
||||
no shortening.
|
||||
START is the minimum length of the name used."
|
||||
(if (eq 'max erc-track-shorten-aggressively)
|
||||
;; Return the unique substrings of all active channels.
|
||||
(erc-unique-substrings active predicate start)
|
||||
;; Otherwise, determine the unique substrings of all channels, and
|
||||
;; for every active channel, return the corresponding substring.
|
||||
;; Given the names of the active channels, we now need to find the
|
||||
;; corresponding short name from the list of all substrings. To
|
||||
;; avoid problems when there are two channels and one is a
|
||||
;; substring of the other (notorious examples are #hurd and
|
||||
;; #hurd-bunny), every candidate gets the longest possible
|
||||
;; substring.
|
||||
(let ((all-substrings (sort
|
||||
(erc-unique-substrings all predicate start)
|
||||
(lambda (a b) (> (length a) (length b)))))
|
||||
result)
|
||||
(dolist (channel active)
|
||||
(let ((substrings all-substrings)
|
||||
candidate
|
||||
winner)
|
||||
(while (and substrings (not winner))
|
||||
(setq candidate (car substrings)
|
||||
substrings (cdr substrings))
|
||||
(when (and (string= candidate
|
||||
(substring channel
|
||||
0
|
||||
(min (length candidate)
|
||||
(length channel))))
|
||||
(not (member candidate result)))
|
||||
(setq winner candidate)))
|
||||
(setq result (cons winner result))))
|
||||
(nreverse result))))
|
||||
|
||||
(defun erc-unique-substrings (strings &optional predicate start)
|
||||
"Return a list of unique substrings of STRINGS."
|
||||
(if (or (not (numberp start))
|
||||
(< start 0))
|
||||
(setq start 2))
|
||||
(mapcar
|
||||
(lambda (str)
|
||||
(let* ((others (delete str (copy-sequence strings)))
|
||||
(maxlen (length str))
|
||||
(i (min start
|
||||
(length str)))
|
||||
candidate
|
||||
done)
|
||||
(if (and (functionp predicate) (not (funcall predicate str)))
|
||||
;; do not shorten if a predicate exists and it returns nil
|
||||
str
|
||||
;; Start with smallest substring candidate, ie. length 1.
|
||||
;; Then check all the others and see whether any of them starts
|
||||
;; with the same substring. While there is such another
|
||||
;; element in the list, increase the length of the candidate.
|
||||
(while (not done)
|
||||
(if (> i maxlen)
|
||||
(setq done t)
|
||||
(setq candidate (substring str 0 i)
|
||||
done (not (erc-unique-substring-1 candidate others))))
|
||||
(setq i (1+ i)))
|
||||
(if (and (= (length candidate) (1- maxlen))
|
||||
(not erc-track-shorten-aggressively))
|
||||
str
|
||||
candidate))))
|
||||
strings))
|
||||
|
||||
(defun erc-unique-substring-1 (candidate others)
|
||||
"Return non-nil when any string in OTHERS starts with CANDIDATE."
|
||||
(let (result other (maxlen (length candidate)))
|
||||
(while (and others
|
||||
(not result))
|
||||
(setq other (car others)
|
||||
others (cdr others))
|
||||
(when (and (>= (length other) maxlen)
|
||||
(string= candidate (substring other 0 maxlen)))
|
||||
(setq result other)))
|
||||
result))
|
||||
|
||||
;;; Test:
|
||||
|
||||
(erc-assert
|
||||
(and
|
||||
;; verify examples from the doc strings
|
||||
(equal (let ((erc-track-shorten-aggressively nil))
|
||||
(erc-unique-channel-names
|
||||
'("#emacs" "#vi" "#electronica" "#folk")
|
||||
'("#emacs" "#vi")))
|
||||
'("#em" "#vi")) ; emacs is different from electronica
|
||||
(equal (let ((erc-track-shorten-aggressively t))
|
||||
(erc-unique-channel-names
|
||||
'("#emacs" "#vi" "#electronica" "#folk")
|
||||
'("#emacs" "#vi")))
|
||||
'("#em" "#v")) ; vi is shortened by one letter
|
||||
(equal (let ((erc-track-shorten-aggressively 'max))
|
||||
(erc-unique-channel-names
|
||||
'("#emacs" "#vi" "#electronica" "#folk")
|
||||
'("#emacs" "#vi")))
|
||||
'("#e" "#v")) ; emacs need not be different from electronica
|
||||
(equal (let ((erc-track-shorten-aggressively nil))
|
||||
(erc-unique-channel-names
|
||||
'("#linux-de" "#linux-fr")
|
||||
'("#linux-de" "#linux-fr")))
|
||||
'("#linux-de" "#linux-fr")) ; shortening by one letter is too aggressive
|
||||
(equal (let ((erc-track-shorten-aggressively t))
|
||||
(erc-unique-channel-names
|
||||
'("#linux-de" "#linux-fr")
|
||||
'("#linux-de" "#linux-fr")))
|
||||
'("#linux-d" "#linux-f")); now we want to be aggressive
|
||||
;; specific problems
|
||||
(equal (let ((erc-track-shorten-aggressively nil))
|
||||
(erc-unique-channel-names
|
||||
'("#dunnet" "#lisp" "#sawfish" "#fsf" "#guile"
|
||||
"#testgnome" "#gnu" "#fsbot" "#hurd" "#hurd-bunny"
|
||||
"#emacs")
|
||||
'("#hurd-bunny" "#hurd" "#sawfish" "#lisp")))
|
||||
'("#hurd-" "#hurd" "#s" "#l"))
|
||||
(equal (let ((erc-track-shorten-aggressively nil))
|
||||
(erc-unique-substrings
|
||||
'("#emacs" "#vi" "#electronica" "#folk")))
|
||||
'("#em" "#vi" "#el" "#f"))
|
||||
(equal (let ((erc-track-shorten-aggressively t))
|
||||
(erc-unique-substrings
|
||||
'("#emacs" "#vi" "#electronica" "#folk")))
|
||||
'("#em" "#v" "#el" "#f"))
|
||||
(equal (let ((erc-track-shorten-aggressively nil))
|
||||
(erc-unique-channel-names
|
||||
'("#emacs" "#burse" "+linux.de" "#starwars"
|
||||
"#bitlbee" "+burse" "#ratpoison")
|
||||
'("+linux.de" "#starwars" "#burse")))
|
||||
'("+l" "#s" "#bu"))
|
||||
(equal (let ((erc-track-shorten-aggressively nil))
|
||||
(erc-unique-channel-names
|
||||
'("fsbot" "#emacs" "deego")
|
||||
'("fsbot")))
|
||||
'("fs"))
|
||||
(equal (let ((erc-track-shorten-aggressively nil))
|
||||
(erc-unique-channel-names
|
||||
'("fsbot" "#emacs" "deego")
|
||||
'("fsbot")
|
||||
(lambda (s)
|
||||
(> (length s) 4))
|
||||
1))
|
||||
'("f"))
|
||||
(equal (let ((erc-track-shorten-aggressively nil))
|
||||
(erc-unique-channel-names
|
||||
'("fsbot" "#emacs" "deego")
|
||||
'("fsbot")
|
||||
(lambda (s)
|
||||
(> (length s) 4))
|
||||
2))
|
||||
'("fs"))
|
||||
(let ((erc-track-shorten-aggressively nil))
|
||||
(equal (erc-unique-channel-names '("deego" "#hurd" "#hurd-bunny" "#emacs")
|
||||
'("#hurd" "#hurd-bunny"))
|
||||
'("#hurd" "#hurd-")))
|
||||
;; general examples
|
||||
(let ((erc-track-shorten-aggressively t))
|
||||
(and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
|
||||
(not (erc-unique-substring-1 "a" '("xyz" "xab")))
|
||||
(equal (erc-unique-substrings '("abc" "xyz" "xab"))
|
||||
'("ab" "xy" "xa"))
|
||||
(equal (erc-unique-substrings '("abc" "abcdefg"))
|
||||
'("abc" "abcd"))))
|
||||
(let ((erc-track-shorten-aggressively nil))
|
||||
(and (equal (erc-unique-substring-1 "abc" '("ab" "abcd")) "abcd")
|
||||
(not (erc-unique-substring-1 "a" '("xyz" "xab")))
|
||||
(equal (erc-unique-substrings '("abc" "xyz" "xab"))
|
||||
'("abc" "xyz" "xab"))
|
||||
(equal (erc-unique-substrings '("abc" "abcdefg"))
|
||||
'("abc" "abcd"))))))
|
||||
|
||||
;;; Module
|
||||
|
||||
;;;###autoload (autoload 'erc-track-mode "erc-track" nil t)
|
||||
(define-erc-module track track-modified-channels
|
||||
"This mode tracks ERC channel buffers with activity."
|
||||
((erc-track-add-to-mode-line erc-track-position-in-mode-line)
|
||||
(setq erc-modified-channels-object (erc-modified-channels-object nil))
|
||||
(erc-update-mode-line)
|
||||
(if (featurep 'xemacs)
|
||||
(defadvice switch-to-buffer (after erc-update (&rest args) activate)
|
||||
(erc-modified-channels-update))
|
||||
(add-hook 'window-configuration-change-hook 'erc-modified-channels-update))
|
||||
(add-hook 'erc-insert-post-hook 'erc-track-modified-channels)
|
||||
(add-hook 'erc-disconnected-hook 'erc-modified-channels-update))
|
||||
((erc-track-remove-from-mode-line)
|
||||
(if (featurep 'xemacs)
|
||||
(ad-disable-advice 'switch-to-buffer 'after 'erc-update)
|
||||
(remove-hook 'window-configuration-change-hook
|
||||
'erc-modified-channels-update))
|
||||
(remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
|
||||
(remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)))
|
||||
|
||||
;;;###autoload (autoload 'erc-track-when-inactive-mode "erc-track" nil t)
|
||||
(define-erc-module track-when-inactive nil
|
||||
"This mode enables channel tracking even for visible buffers,
|
||||
if you are inactivity."
|
||||
((if (featurep 'xemacs)
|
||||
(defadvice switch-to-buffer (after erc-update-when-inactive (&rest args) activate)
|
||||
(erc-user-is-active))
|
||||
(add-hook 'window-configuration-change-hook 'erc-user-is-active))
|
||||
(add-hook 'erc-send-completed-hook 'erc-user-is-active)
|
||||
(add-hook 'erc-server-001-functions 'erc-user-is-active))
|
||||
((erc-track-remove-from-mode-line)
|
||||
(if (featurep 'xemacs)
|
||||
(ad-disable-advice 'switch-to-buffer 'after 'erc-update-when-inactive)
|
||||
(remove-hook 'window-configuration-change-hook 'erc-user-is-active))
|
||||
(remove-hook 'erc-send-completed-hook 'erc-user-is-active)
|
||||
(remove-hook 'erc-server-001-functions 'erc-user-is-active)
|
||||
(remove-hook 'erc-timer-hook 'erc-user-is-active)))
|
||||
|
||||
;;; Visibility
|
||||
|
||||
(defvar erc-buffer-activity nil
|
||||
"Last time the user sent something.")
|
||||
|
||||
(defvar erc-buffer-activity-timeout 10
|
||||
"How many seconds of inactivity by the user
|
||||
to consider when `erc-track-visibility' is set to
|
||||
only consider active buffers visible.")
|
||||
|
||||
(defun erc-user-is-active (&rest ignore)
|
||||
"Set `erc-buffer-activity'."
|
||||
(setq erc-buffer-activity (erc-current-time))
|
||||
(erc-track-modified-channels))
|
||||
|
||||
(defun erc-buffer-visible (buffer)
|
||||
"Return non-nil when the buffer is visible."
|
||||
(if erc-track-when-inactive-mode
|
||||
(when erc-buffer-activity; could be nil
|
||||
(and (get-buffer-window buffer erc-track-visibility)
|
||||
(<= (erc-time-diff erc-buffer-activity (erc-current-time))
|
||||
erc-buffer-activity-timeout)))
|
||||
(get-buffer-window buffer erc-track-visibility)))
|
||||
|
||||
;;; Tracking the channel modifications
|
||||
|
||||
(defvar erc-modified-channels-update-inside nil
|
||||
"Variable to prevent running `erc-modified-channels-update' multiple
|
||||
times. Without it, you cannot debug `erc-modified-channels-display',
|
||||
because the debugger also cases changes to the window-configuration.")
|
||||
|
||||
(defun erc-modified-channels-update (&rest args)
|
||||
"This function updates the information in `erc-modified-channels-alist'
|
||||
according to buffer visibility. It calls
|
||||
`erc-modified-channels-display' at the end. This should usually be
|
||||
called via `window-configuration-change-hook'.
|
||||
ARGS are ignored."
|
||||
(interactive)
|
||||
(unless erc-modified-channels-update-inside
|
||||
(let ((erc-modified-channels-update-inside t))
|
||||
(mapcar (lambda (elt)
|
||||
(let ((buffer (car elt)))
|
||||
(when (or (not (bufferp buffer))
|
||||
(not (buffer-live-p buffer))
|
||||
(erc-buffer-visible buffer)
|
||||
(not (with-current-buffer buffer
|
||||
erc-server-connected)))
|
||||
(erc-modified-channels-remove-buffer buffer))))
|
||||
erc-modified-channels-alist)
|
||||
(erc-modified-channels-display)
|
||||
(force-mode-line-update t))))
|
||||
|
||||
(defun erc-make-mode-line-buffer-name (string buffer &optional faces count)
|
||||
"Return STRING as a button that switches to BUFFER when clicked.
|
||||
If FACES are provided, color STRING with them."
|
||||
;; We define a new sparse keymap every time, because 1. this data
|
||||
;; structure is very small, the alternative would require us to
|
||||
;; defvar a keymap, 2. the user is not interested in customizing it
|
||||
;; (really?), 3. the defun needs to switch to BUFFER, so we would
|
||||
;; need to save that value somewhere.
|
||||
(let ((map (make-sparse-keymap))
|
||||
(name (if erc-track-showcount
|
||||
(concat string
|
||||
erc-track-showcount-string
|
||||
(int-to-string count))
|
||||
(copy-sequence string))))
|
||||
(define-key map (vector 'mode-line 'mouse-2)
|
||||
`(lambda (e)
|
||||
(interactive "e")
|
||||
(save-selected-window
|
||||
(select-window
|
||||
(posn-window (event-start e)))
|
||||
(switch-to-buffer ,buffer))))
|
||||
(define-key map (vector 'mode-line 'mouse-3)
|
||||
`(lambda (e)
|
||||
(interactive "e")
|
||||
(save-selected-window
|
||||
(select-window
|
||||
(posn-window (event-start e)))
|
||||
(switch-to-buffer-other-window ,buffer))))
|
||||
(put-text-property 0 (length name) 'local-map map name)
|
||||
(when (and faces erc-track-use-faces)
|
||||
(put-text-property 0 (length name) 'face faces name))
|
||||
name))
|
||||
|
||||
(defun erc-modified-channels-display ()
|
||||
"Set `erc-modified-channels-object'
|
||||
according to `erc-modified-channels-alist'.
|
||||
Use `erc-make-mode-line-buffer-name' to create buttons."
|
||||
(if (or
|
||||
(eq 'mostactive erc-track-switch-direction)
|
||||
(eq 'leastactive erc-track-switch-direction))
|
||||
(erc-track-sort-by-activest))
|
||||
(if (null erc-modified-channels-alist)
|
||||
(setq erc-modified-channels-object (erc-modified-channels-object nil))
|
||||
;; erc-modified-channels-alist contains all the data we need. To
|
||||
;; better understand what is going on, we split things up into
|
||||
;; four lists: BUFFERS, COUNTS, SHORT-NAMES, and FACES. These
|
||||
;; four lists we use to create a new
|
||||
;; `erc-modified-channels-object' using
|
||||
;; `erc-make-mode-line-buffer-name'.
|
||||
(let* ((buffers (mapcar 'car erc-modified-channels-alist))
|
||||
(counts (mapcar 'cadr erc-modified-channels-alist))
|
||||
(faces (mapcar 'cddr erc-modified-channels-alist))
|
||||
(long-names (mapcar #'(lambda (buf)
|
||||
(or (buffer-name buf)
|
||||
""))
|
||||
buffers))
|
||||
(short-names (if (functionp erc-track-shorten-function)
|
||||
(funcall erc-track-shorten-function
|
||||
long-names)
|
||||
long-names))
|
||||
strings)
|
||||
(while buffers
|
||||
(when (car short-names)
|
||||
(setq strings (cons (erc-make-mode-line-buffer-name
|
||||
(car short-names)
|
||||
(car buffers)
|
||||
(car faces)
|
||||
(car counts))
|
||||
strings)))
|
||||
(setq short-names (cdr short-names)
|
||||
buffers (cdr buffers)
|
||||
counts (cdr counts)
|
||||
faces (cdr faces)))
|
||||
(when (featurep 'xemacs)
|
||||
(erc-modified-channels-object nil))
|
||||
(setq erc-modified-channels-object
|
||||
(erc-modified-channels-object strings)))))
|
||||
|
||||
(defun erc-modified-channels-remove-buffer (buffer)
|
||||
"Remove BUFFER from `erc-modified-channels-alist'."
|
||||
(interactive "bBuffer: ")
|
||||
(setq erc-modified-channels-alist
|
||||
(delete (assq buffer erc-modified-channels-alist)
|
||||
erc-modified-channels-alist))
|
||||
(when (interactive-p)
|
||||
(erc-modified-channels-display)))
|
||||
|
||||
(defun erc-track-find-face (faces)
|
||||
"Return the face to use in the modeline from the faces in FACES.
|
||||
If `erc-track-faces-priority-list' is set, the one from FACES who is
|
||||
first in that list will be used."
|
||||
(let ((candidates erc-track-faces-priority-list)
|
||||
candidate face)
|
||||
(while (and candidates (not face))
|
||||
(setq candidate (car candidates)
|
||||
candidates (cdr candidates))
|
||||
(when (memq candidate faces)
|
||||
(setq face candidate)))
|
||||
face))
|
||||
|
||||
(defun erc-track-modified-channels ()
|
||||
"Hook function for `erc-insert-post-hook' to check if the current
|
||||
buffer should be added to the modeline as a hidden, modified
|
||||
channel. Assumes it will only be called when current-buffer
|
||||
is in `erc-mode'."
|
||||
(let ((this-channel (or (erc-default-target)
|
||||
(buffer-name (current-buffer)))))
|
||||
(if (and (not (erc-buffer-visible (current-buffer)))
|
||||
(not (member this-channel erc-track-exclude))
|
||||
(not (and erc-track-exclude-server-buffer
|
||||
(string= this-channel
|
||||
(buffer-name (erc-server-buffer)))))
|
||||
(not (erc-message-type-member
|
||||
(or (erc-find-parsed-property)
|
||||
(point-min))
|
||||
erc-track-exclude-types)))
|
||||
;; If the active buffer is not visible (not shown in a
|
||||
;; window), and not to be excluded, determine the kinds of
|
||||
;; faces used in the current message, and unless the user
|
||||
;; wants to ignore changes in certain channels where there
|
||||
;; are no faces corresponding to `erc-track-faces-priority-list',
|
||||
;; and the faces in the current message are found in said
|
||||
;; priority list, add the buffer to the erc-modified-channels-alist,
|
||||
;; if it is not already there. If the buffer is already on the list
|
||||
;; (in the car), change its face attribute (in the cddr) if
|
||||
;; necessary. See `erc-modified-channels-alist' for the
|
||||
;; exact data structure used.
|
||||
(let ((faces (erc-faces-in (buffer-string))))
|
||||
(unless (and
|
||||
(or (eq erc-track-priority-faces-only 'all)
|
||||
(member this-channel erc-track-priority-faces-only))
|
||||
(not (catch 'found
|
||||
(dolist (f faces)
|
||||
(when (member f erc-track-faces-priority-list)
|
||||
(throw 'found t))))))
|
||||
(if (not (assq (current-buffer) erc-modified-channels-alist))
|
||||
;; Add buffer, faces and counts
|
||||
(setq erc-modified-channels-alist
|
||||
(cons (cons (current-buffer)
|
||||
(cons 1 (erc-track-find-face faces)))
|
||||
erc-modified-channels-alist))
|
||||
;; Else modify the face for the buffer, if necessary.
|
||||
(when faces
|
||||
(let* ((cell (assq (current-buffer)
|
||||
erc-modified-channels-alist))
|
||||
(old-face (cddr cell))
|
||||
(new-face (erc-track-find-face
|
||||
(if old-face
|
||||
(cons old-face faces)
|
||||
faces))))
|
||||
(setcdr cell (cons (1+ (cadr cell)) new-face)))))
|
||||
;; And display it
|
||||
(erc-modified-channels-display)))
|
||||
;; Else if the active buffer is the current buffer, remove it
|
||||
;; from our list.
|
||||
(when (or (erc-buffer-visible (current-buffer))
|
||||
(and this-channel
|
||||
(assq (current-buffer) erc-modified-channels-alist)
|
||||
(member this-channel erc-track-exclude)))
|
||||
;; Remove it from mode-line if buffer is visible or
|
||||
;; channel was added to erc-track-exclude recently.
|
||||
(erc-modified-channels-remove-buffer (current-buffer))
|
||||
(erc-modified-channels-display)))))
|
||||
|
||||
(defun erc-faces-in (str)
|
||||
"Return a list of all faces used in STR."
|
||||
(let ((i 0)
|
||||
(m (length str))
|
||||
(faces (erc-list (get-text-property 0 'face str))))
|
||||
(while (and (setq i (next-single-property-change i 'face str m))
|
||||
(not (= i m)))
|
||||
(dolist (face (erc-list (get-text-property i 'face str)))
|
||||
(add-to-list 'faces face)))
|
||||
faces))
|
||||
|
||||
(erc-assert
|
||||
(let ((str "is bold"))
|
||||
(put-text-property 3 (length str)
|
||||
'face '(bold erc-current-nick-face)
|
||||
str)
|
||||
(erc-faces-in str)))
|
||||
|
||||
(defun erc-find-parsed-property ()
|
||||
"Find the next occurrence of the `erc-parsed' text property."
|
||||
(text-property-not-all (point-min) (point-max) 'erc-parsed nil))
|
||||
|
||||
;;; Buffer switching
|
||||
|
||||
(defvar erc-track-last-non-erc-buffer nil
|
||||
"Stores the name of the last buffer you were in before activating
|
||||
`erc-track-switch-buffers'")
|
||||
|
||||
(defun erc-track-sort-by-activest ()
|
||||
"Sort erc-modified-channels-alist by activity.
|
||||
That means the number of unseen messages in a channel."
|
||||
(setq erc-modified-channels-alist
|
||||
(sort erc-modified-channels-alist
|
||||
(lambda (a b) (> (nth 1 a) (nth 1 b))))))
|
||||
|
||||
(defun erc-track-get-active-buffer (arg)
|
||||
"Return the buffer name of ARG in `erc-modified-channels-alist'.
|
||||
Negative arguments index in the opposite direction. This direction is
|
||||
relative to `erc-track-switch-direction'"
|
||||
(let ((dir erc-track-switch-direction)
|
||||
offset)
|
||||
(when (< arg 0)
|
||||
(setq dir (case dir
|
||||
(oldest 'newest)
|
||||
(newest 'oldest)
|
||||
(mostactive 'leastactive)
|
||||
(leastactive 'mostactive)))
|
||||
(setq arg (- arg)))
|
||||
(setq offset (case dir
|
||||
((oldest leastactive)
|
||||
(- (length erc-modified-channels-alist) arg))
|
||||
(t (1- arg))))
|
||||
;; normalise out of range user input
|
||||
(cond ((>= offset (length erc-modified-channels-alist))
|
||||
(setq offset (1- (length erc-modified-channels-alist))))
|
||||
((< offset 0)
|
||||
(setq offset 0)))
|
||||
(car (nth offset erc-modified-channels-alist))))
|
||||
|
||||
(defun erc-track-switch-buffer (arg)
|
||||
"Switch to the next active ERC buffer, or if there are no active buffers,
|
||||
switch back to the last non-ERC buffer visited. Next is defined by
|
||||
`erc-track-switch-direction', a negative argument will reverse this."
|
||||
(interactive "p")
|
||||
(when erc-track-mode
|
||||
(cond (erc-modified-channels-alist
|
||||
;; if we're not in erc-mode, set this buffer to return to
|
||||
(unless (eq major-mode 'erc-mode)
|
||||
(setq erc-track-last-non-erc-buffer (current-buffer)))
|
||||
;; and jump to the next active channel
|
||||
(switch-to-buffer (erc-track-get-active-buffer arg)))
|
||||
;; if no active channels, switch back to what we were doing before
|
||||
((and erc-track-last-non-erc-buffer
|
||||
erc-track-switch-from-erc
|
||||
(buffer-live-p erc-track-last-non-erc-buffer))
|
||||
(switch-to-buffer erc-track-last-non-erc-buffer)))))
|
||||
|
||||
;; These bindings are global, because they pop us from any other
|
||||
;; buffer to an active ERC buffer!
|
||||
|
||||
(global-set-key (kbd "C-c C-@") 'erc-track-switch-buffer)
|
||||
(global-set-key (kbd "C-c C-SPC") 'erc-track-switch-buffer)
|
||||
|
||||
(provide 'erc-track)
|
||||
|
||||
;;; erc-track.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 11b439f5-e5d7-4c6c-bb3f-eda98f9b0ac1
|
||||
121
lisp/erc/erc-truncate.el
Normal file
121
lisp/erc/erc-truncate.el
Normal file
|
|
@ -0,0 +1,121 @@
|
|||
;;; erc-truncate.el --- Functions for truncating ERC buffers
|
||||
|
||||
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Andreas Fuchs <asf@void.at>
|
||||
;; Keywords: IRC, chat, client, Internet, logging
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This implements buffer truncation (and optional log file writing
|
||||
;; support for the Emacs IRC client. Use `erc-truncate-mode' to switch
|
||||
;; on. Use `erc-enable-logging' to enable logging of the stuff which
|
||||
;; is getting truncated.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
|
||||
(defgroup erc-truncate nil
|
||||
"Truncate buffers when they reach a certain size"
|
||||
:group 'erc)
|
||||
|
||||
(defcustom erc-max-buffer-size 30000
|
||||
"*Maximum size in chars of each ERC buffer.
|
||||
Used only when auto-truncation is enabled.
|
||||
\(see `erc-truncate-buffer' and `erc-insert-post-hook')."
|
||||
:group 'erc-truncate
|
||||
:type 'integer)
|
||||
|
||||
;;;###autoload (autoload 'erc-truncate-mode "erc-truncate" nil t)
|
||||
(define-erc-module truncate nil
|
||||
"Truncate a query buffer if it gets too large.
|
||||
This prevents the query buffer from getting too large, which can
|
||||
bring any grown emacs to its knees after a few days worth of
|
||||
tracking heavy-traffic channels."
|
||||
;;enable
|
||||
((add-hook 'erc-insert-post-hook 'erc-truncate-buffer))
|
||||
;; disable
|
||||
((remove-hook 'erc-insert-post-hook 'erc-truncate-buffer)))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-truncate-buffer-to-size (size &optional buffer)
|
||||
"Truncates the buffer to the size SIZE.
|
||||
If BUFFER is not provided, the current buffer is assumed. The deleted
|
||||
region is logged if `erc-logging-enabled' returns non-nil."
|
||||
;; If buffer is non-nil, but get-buffer does not return anything,
|
||||
;; then this is a bug. If buffer is a buffer name, get the buffer
|
||||
;; object. If buffer is nil, use the current buffer.
|
||||
(if (not buffer)
|
||||
(setq buffer (current-buffer))
|
||||
(unless (get-buffer buffer)
|
||||
(error "erc-truncate-buffer-to-size: %S is not a buffer" buffer)))
|
||||
(when (> (buffer-size buffer) (+ size 512))
|
||||
(save-excursion
|
||||
(set-buffer buffer)
|
||||
;; Note that when erc-insert-post-hook runs, the buffer is
|
||||
;; narrowed to the new message. So do this delicate widening.
|
||||
;; I am not sure, I think this was not recommended behaviour in
|
||||
;; Emacs 20.
|
||||
(save-restriction
|
||||
(widen)
|
||||
(let ((end (- erc-insert-marker size)))
|
||||
;; truncate at line boundaries
|
||||
(goto-char end)
|
||||
(beginning-of-line)
|
||||
(setq end (point))
|
||||
;; try to save the current buffer using
|
||||
;; `erc-save-buffer-in-logs'. We use this, in case the
|
||||
;; user has both `erc-save-buffer-in-logs' and
|
||||
;; `erc-truncate-buffer' in `erc-insert-post-hook'. If
|
||||
;; this is the case, only the non-saved part of the current
|
||||
;; buffer should be saved. Rather than appending the
|
||||
;; deleted part of the buffer to the log file.
|
||||
;;
|
||||
;; Alternatively this could be made conditional on:
|
||||
;; (not (memq 'erc-save-buffer-in-logs
|
||||
;; erc-insert-post-hook))
|
||||
;; Comments?
|
||||
(when (and (boundp 'erc-enable-logging)
|
||||
erc-enable-logging
|
||||
(erc-logging-enabled buffer))
|
||||
(erc-save-buffer-in-logs))
|
||||
;; disable undoing for the truncating
|
||||
(buffer-disable-undo)
|
||||
(let ((inhibit-read-only t))
|
||||
(delete-region (point-min) end)))
|
||||
(buffer-enable-undo)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-truncate-buffer ()
|
||||
"Truncates the current buffer to `erc-max-buffer-size'.
|
||||
Meant to be used in hooks, like `erc-insert-post-hook'."
|
||||
(interactive)
|
||||
(erc-truncate-buffer-to-size erc-max-buffer-size))
|
||||
|
||||
(provide 'erc-truncate)
|
||||
;;; erc-truncate.el ends here
|
||||
;;
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: t
|
||||
;; tab-width: 8
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 22a2ea78-871f-4870-8f1e-efe534170311
|
||||
130
lisp/erc/erc-xdcc.el
Normal file
130
lisp/erc/erc-xdcc.el
Normal file
|
|
@ -0,0 +1,130 @@
|
|||
;;; erc-xdcc.el --- XDCC file-server support for ERC
|
||||
|
||||
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Mario Lang <mlang@delysid.org>
|
||||
;; Keywords: comm, processes
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file provides a very simple XDCC file server for the Emacs IRC Client.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'erc-dcc)
|
||||
|
||||
(defcustom erc-xdcc-files nil
|
||||
"*List of files to offer via XDCC.
|
||||
Your friends should issue \"/ctcp yournick XDCC list\" to see this."
|
||||
:group 'erc-dcc
|
||||
:type '(repeat file))
|
||||
|
||||
(defcustom erc-xdcc-verbose-flag t
|
||||
"*Report XDCC CTCP requests in the server buffer."
|
||||
:group 'erc-dcc
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-xdcc-handler-alist
|
||||
'(("help" . erc-xdcc-help)
|
||||
("list" . erc-xdcc-list)
|
||||
("send" . erc-xdcc-send))
|
||||
"*Sub-command handler alist for XDCC CTCP queries."
|
||||
:group 'erc-dcc
|
||||
:type '(alist :key-type (string :tag "Sub-command") :value-type function))
|
||||
|
||||
(defcustom erc-xdcc-help-text
|
||||
'(("Hey " nick ", wondering how this works? Pretty easy.")
|
||||
("Available commands: XDCC ["
|
||||
(mapconcat 'car erc-xdcc-handler-alist "|") "]")
|
||||
("Type \"/ctcp " (erc-current-nick)
|
||||
" XDCC list\" to see the list of offered files, then type \"/ctcp "
|
||||
(erc-current-nick) " XDCC send #\" to get a particular file number."))
|
||||
"*Help text sent in response to XDCC help command.
|
||||
A list of messages, each consisting of strings and expressions, expressions
|
||||
being evaluated and should return stings."
|
||||
:group 'erc-dcc
|
||||
:type '(repeat (repeat :tag "Message" (choice string sexp))))
|
||||
|
||||
;;;###autoload
|
||||
(defun erc-xdcc-add-file (file)
|
||||
"Add a file to `erc-xdcc-files'."
|
||||
(interactive "fFilename to add to XDCC: ")
|
||||
(if (file-exists-p file)
|
||||
(add-to-list 'erc-xdcc-files file)))
|
||||
|
||||
(defun erc-xdcc-reply (proc nick msg)
|
||||
(process-send-string proc
|
||||
(format "PRIVMSG %s :%s\n" nick msg)))
|
||||
|
||||
;; CTCP query handlers
|
||||
|
||||
(defvar erc-ctcp-query-XDCC-hook '(erc-xdcc)
|
||||
"Hook called whenever a CTCP XDCC message is received.")
|
||||
|
||||
(defun erc-xdcc (proc nick login host to query)
|
||||
"Handle incoming CTCP XDCC queries."
|
||||
(when erc-xdcc-verbose-flag
|
||||
(erc-display-message nil 'notice proc
|
||||
(format "XDCC %s (%s@%s) sends %S" nick login host query)))
|
||||
(let* ((args (cdr (delete "" (split-string query " "))))
|
||||
(handler (cdr (assoc (downcase (car args)) erc-xdcc-handler-alist))))
|
||||
(if (and handler (functionp handler))
|
||||
(funcall handler proc nick login host (cdr args))
|
||||
(erc-xdcc-reply
|
||||
proc nick
|
||||
(format "Unknown XDCC sub-command, try \"/ctcp %s XDCC help\""
|
||||
(erc-current-nick))))))
|
||||
|
||||
(defun erc-xdcc-help (proc nick login host args)
|
||||
"Send basic help information to NICK."
|
||||
(mapc
|
||||
(lambda (msg)
|
||||
(erc-xdcc-reply proc nick
|
||||
(mapconcat (lambda (elt) (if (stringp elt) elt (eval elt))) msg "")))
|
||||
erc-xdcc-help-text))
|
||||
|
||||
(defun erc-xdcc-list (proc nick login host args)
|
||||
"Show the contents of `erc-xdcc-files' via privmsg to NICK."
|
||||
(if (null erc-xdcc-files)
|
||||
(erc-xdcc-reply proc nick "No files offered, sorry")
|
||||
(erc-xdcc-reply proc nick "Num Filename")
|
||||
(erc-xdcc-reply proc nick "--- -------------")
|
||||
(let ((n 0))
|
||||
(dolist (file erc-xdcc-files)
|
||||
(erc-xdcc-reply proc nick
|
||||
(format "%02d. %s"
|
||||
(setq n (1+ n))
|
||||
(erc-dcc-file-to-name file)))))))
|
||||
|
||||
(defun erc-xdcc-send (proc nick login host args)
|
||||
"Send a file to NICK."
|
||||
(let ((n (string-to-number (car args)))
|
||||
(len (length erc-xdcc-files)))
|
||||
(cond
|
||||
((= len 0)
|
||||
(erc-xdcc-reply proc nick "No files offered, sorry"))
|
||||
((or (< n 1) (> n len))
|
||||
(erc-xdcc-reply proc nick (format "%d out of range" n)))
|
||||
(t (erc-dcc-send-file nick (nth (1- n) erc-xdcc-files) proc)))))
|
||||
|
||||
(provide 'erc-xdcc)
|
||||
|
||||
;; arch-tag: a13b62fe-2399-4562-af4e-f18a8dd4b9c8
|
||||
;;; erc-xdcc.el ends here
|
||||
6145
lisp/erc/erc.el
Normal file
6145
lisp/erc/erc.el
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -2450,6 +2450,10 @@ is specified, returning t if it is specified."
|
|||
"Non-nil if SYM could be dangerous as a file-local variable with value VAL.
|
||||
If VAL is nil or omitted, the question is whether any value might be
|
||||
dangerous."
|
||||
;; If this is an alias, check the base name.
|
||||
(condition-case nil
|
||||
(setq sym (indirect-variable sym))
|
||||
(error nil))
|
||||
(let ((safep (get sym 'safe-local-variable)))
|
||||
(or (get sym 'risky-local-variable)
|
||||
(and (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-commands?$\\|-predicates?$\\|font-lock-keywords$\\|font-lock-keywords-[0-9]+$\\|font-lock-syntactic-keywords$\\|-frame-alist$\\|-mode-alist$\\|-map$\\|-map-alist$"
|
||||
|
|
|
|||
|
|
@ -1,8 +1,60 @@
|
|||
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): Say the part has been
|
||||
decoded.
|
||||
(mm-uu-diff-extract): Ditto.
|
||||
|
||||
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.
|
||||
the given one; decode charset.
|
||||
|
||||
2006-01-21 Kevin Ryde <user42@zip.com.au>
|
||||
|
||||
|
|
@ -122,8 +174,8 @@
|
|||
|
||||
2006-01-05 Reiner Steib <Reiner.Steib@gmx.de>
|
||||
|
||||
* gnus-group.el (gnus-useful-groups): Use Gmane for ding. Use
|
||||
nntp for bug archive.
|
||||
* gnus-group.el (gnus-useful-groups): Use Gmane for ding.
|
||||
Use nntp for bug archive.
|
||||
|
||||
2006-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
|
|
@ -162,7 +214,7 @@
|
|||
* 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)
|
||||
2005-12-19 Mark Plaksin <happy@mcplaksin.org> (tiny change)
|
||||
|
||||
* nnrss.el (nnrss-check-group): Put the RSS dc:subject in the
|
||||
article.
|
||||
|
|
@ -235,7 +287,7 @@
|
|||
|
||||
2005-12-09 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
|
||||
|
||||
* mm-decode.el (mm-display-external): Add lacked cdr.
|
||||
* mm-decode.el (mm-display-external): Add missing cdr.
|
||||
|
||||
2005-12-12 Richard M. Stallman <rms@gnu.org>
|
||||
|
||||
|
|
@ -288,7 +340,7 @@
|
|||
* nnmail.el (nnmail-fancy-expiry-target): Protect against invalid
|
||||
date header.
|
||||
|
||||
2005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny patch)
|
||||
2005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny patch)
|
||||
|
||||
* imap.el (imap-kerberos4-open): Ignore SSL stuff.
|
||||
|
||||
|
|
@ -329,7 +381,7 @@
|
|||
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
|
||||
|
|
@ -379,8 +431,8 @@
|
|||
(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-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'
|
||||
|
|
@ -412,7 +464,7 @@
|
|||
whitespace removed in revision 7.8. Use concatenated string to
|
||||
protect trailing whitespace.
|
||||
|
||||
2005-10-27 Jouni K Seppanen <jks@iki.fi> (tiny change)
|
||||
2005-10-27 Jouni K Seppanen <jks@iki.fi> (tiny change)
|
||||
|
||||
* nnimap.el (nnimap-search-uids-not-since-is-evil): Add variable.
|
||||
(nnimap-request-expire-articles): Use it to avoid sending 'UID
|
||||
|
|
@ -511,11 +563,11 @@
|
|||
* message.el (message-expand-group): Pass the common
|
||||
prefix substring of completion to `display-completion-list'.
|
||||
|
||||
2005-10-09 Daniel Brockman <daniel@brockman.se>
|
||||
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)
|
||||
2005-01-21 Derek Atkins <warlord@MIT.EDU> (tiny change)
|
||||
|
||||
* pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache.
|
||||
|
||||
|
|
@ -1777,11 +1829,11 @@
|
|||
|
||||
* nnimap.el (nnimap-retrieve-headers-from-server): Fix last change.
|
||||
|
||||
2005-03-10 Arne J,Ax(Brgensen <arne@arnested.dk> (tiny change)
|
||||
2005-03-10 Arne J,Ax(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)
|
||||
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
|
||||
|
|
@ -2352,7 +2404,7 @@
|
|||
|
||||
* legacy-gnus-agent.el
|
||||
(gnus-agent-convert-to-compressed-agentview-prompt):
|
||||
New function. Used internally to only display 'gnus converting
|
||||
New function. Used internally to only display 'gnus converting
|
||||
files' message when actually necessary.
|
||||
|
||||
* gnus-sum.el: Remove (require 'gnus-agent) as required
|
||||
|
|
@ -2369,7 +2421,7 @@
|
|||
(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
|
||||
(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.
|
||||
|
|
@ -2465,12 +2517,12 @@
|
|||
* gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to
|
||||
error.
|
||||
|
||||
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
|
||||
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>
|
||||
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
|
||||
|
|
@ -2479,9 +2531,9 @@
|
|||
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>
|
||||
2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
|
||||
|
||||
* legacy-gnus-agent.el (): New. Provides converters that are only
|
||||
* 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
|
||||
|
|
@ -2499,7 +2551,7 @@
|
|||
should be protected from potentially irreversable changes by the
|
||||
function.
|
||||
|
||||
2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
|
||||
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.
|
||||
|
|
@ -2512,7 +2564,7 @@
|
|||
(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>
|
||||
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
|
||||
|
|
@ -2524,18 +2576,18 @@
|
|||
* 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>
|
||||
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>
|
||||
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>
|
||||
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.
|
||||
|
|
@ -3337,7 +3389,7 @@
|
|||
* gnus-msg.el (gnus-summary-followup-with-original):
|
||||
Document yanking of region when active.
|
||||
|
||||
2004-04-13 Kevin Greiner <kgreiner@xpediantsolutions.com>
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;; mailcap.el --- MIME media types configuration
|
||||
|
||||
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
||||
;; 2005 Free Software Foundation, Inc.
|
||||
;; 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: William M. Perry <wmperry@aventail.com>
|
||||
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
|
|
@ -640,30 +640,31 @@ to supply to the test."
|
|||
(viewer (cdr (assoc 'viewer viewer-info)))
|
||||
(default-directory (expand-file-name "~/"))
|
||||
status parsed-test cache result)
|
||||
(if (setq cache (assoc test mailcap-viewer-test-cache))
|
||||
(cadr cache)
|
||||
(setq
|
||||
result
|
||||
(cond
|
||||
((not test-info) t) ; No test clause
|
||||
((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)))
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -1388,8 +1388,13 @@ should be sent in several parts. If it is nil, the size is unlimited."
|
|||
(integer 1000000)))
|
||||
|
||||
(defcustom message-alternative-emails nil
|
||||
"A regexp to match the alternative email addresses.
|
||||
The first matched address (not primary one) is used in the From field."
|
||||
"*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)
|
||||
|
|
@ -5546,10 +5551,6 @@ are not included."
|
|||
(when message-default-mail-headers
|
||||
(insert message-default-mail-headers)
|
||||
(or (bolp) (insert ?\n)))
|
||||
(save-restriction
|
||||
(message-narrow-to-headers)
|
||||
(if message-alternative-emails
|
||||
(message-use-alternative-email-as-from)))
|
||||
(when message-generate-headers-first
|
||||
(message-generate-headers
|
||||
(message-headers-to-generate
|
||||
|
|
@ -5565,6 +5566,12 @@ are not included."
|
|||
(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))
|
||||
|
||||
|
|
@ -6848,6 +6855,9 @@ regexp VARSTR."
|
|||
(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"))
|
||||
(emails
|
||||
|
|
@ -6862,6 +6872,7 @@ regexp VARSTR."
|
|||
emails nil))
|
||||
(pop emails))
|
||||
(unless (or (not email) (equal email user-mail-address))
|
||||
(message-remove-header "From")
|
||||
(goto-char (point-max))
|
||||
(insert "From: " email "\n"))))
|
||||
|
||||
|
|
|
|||
|
|
@ -266,7 +266,7 @@ Return that buffer."
|
|||
|
||||
(defun mm-uu-emacs-sources-extract ()
|
||||
(mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
|
||||
'("application/emacs-lisp")
|
||||
'("application/emacs-lisp" (charset . gnus-decoded))
|
||||
nil nil
|
||||
(list mm-dissect-disposition
|
||||
(cons 'filename file-name))))
|
||||
|
|
@ -282,7 +282,7 @@ Return that buffer."
|
|||
|
||||
(defun mm-uu-diff-extract ()
|
||||
(mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
|
||||
'("text/x-patch")))
|
||||
'("text/x-patch" (charset . gnus-decoded))))
|
||||
|
||||
(defun mm-uu-diff-test ()
|
||||
(and gnus-newsgroup-name
|
||||
|
|
@ -509,31 +509,53 @@ value of `mm-uu-text-plain-type'."
|
|||
(setq result (cons "multipart/mixed" (nreverse result))))
|
||||
result)))
|
||||
|
||||
(defun mm-uu-dissect-text-parts (handle)
|
||||
"Dissect text parts and put uu handles into HANDLE."
|
||||
;;;###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)))
|
||||
(mm-uu-dissect-text-parts elem decoded)))
|
||||
((bufferp buffer)
|
||||
(let ((type (mm-handle-media-type handle))
|
||||
(case-fold-search t) ;; string-match
|
||||
encoding children)
|
||||
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
|
||||
(if (setq encoding (mm-handle-encoding handle))
|
||||
;; Inherit the multibyteness of the `buffer'.
|
||||
(with-temp-buffer
|
||||
(insert-buffer-substring buffer)
|
||||
(mm-decode-content-transfer-encoding
|
||||
encoding type)
|
||||
(mm-uu-dissect t (mm-handle-type handle)))
|
||||
(mm-uu-dissect t (mm-handle-type handle))))))
|
||||
(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)
|
||||
|
|
@ -544,10 +566,10 @@ value of `mm-uu-text-plain-type'."
|
|||
(setcdr handle (cdr children))
|
||||
(setcar handle (car children)) ;; "multipart/mixed"
|
||||
(dolist (elem (cdr children))
|
||||
(mm-uu-dissect-text-parts elem))))))
|
||||
(mm-uu-dissect-text-parts elem decoded))))))
|
||||
(t
|
||||
(dolist (elem handle)
|
||||
(mm-uu-dissect-text-parts elem))))))
|
||||
(mm-uu-dissect-text-parts elem decoded))))))
|
||||
|
||||
(provide 'mm-uu)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
;;; nnweb.el --- retrieving articles via web search engines
|
||||
|
||||
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
|
||||
;; 2004, 2005 Free Software Foundation, Inc.
|
||||
;; 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
|
||||
;; Keywords: news
|
||||
|
|
@ -27,11 +27,8 @@
|
|||
|
||||
;; Note: You need to have `w3' installed for some functions to work.
|
||||
|
||||
;; FIXME: Due to changes in the HTML output of Google Groups and Gmane, stuff
|
||||
;; related to web groups (gnus-group-make-web-group) doesn't work anymore.
|
||||
|
||||
;; Fetching an article by MID (cf. gnus-refer-article-method) over Google
|
||||
;; Groups should work.
|
||||
;; FIXME: Due to changes in the HTML output of Gmane, stuff related to Gmane
|
||||
;; web groups (`gnus-group-make-web-group') doesn't work anymore.
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -61,6 +58,7 @@ 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)
|
||||
|
|
@ -69,8 +67,9 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
(base . "http://groups.google.com")
|
||||
(identifier . nnweb-google-identity))
|
||||
(dejanews ;; alias of google
|
||||
(article . ignore)
|
||||
(id . "http://groups.google.com/groups?selm=%s&output=gplain")
|
||||
(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)
|
||||
|
|
@ -100,7 +99,7 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
|
||||
(defvoo nnweb-articles nil)
|
||||
(defvoo nnweb-buffer nil)
|
||||
(defvoo nnweb-group-alist nil)
|
||||
(defvar nnweb-group-alist nil)
|
||||
(defvoo nnweb-group nil)
|
||||
(defvoo nnweb-hashtb nil)
|
||||
|
||||
|
|
@ -123,25 +122,19 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
(deffoo nnweb-request-scan (&optional group server)
|
||||
(nnweb-possibly-change-server group server)
|
||||
(if nnweb-ephemeral-p
|
||||
(setq nnweb-hashtb (gnus-make-hashtable 4095)))
|
||||
(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 nil server)
|
||||
(when (and group
|
||||
(not (equal group nnweb-group))
|
||||
(not nnweb-ephemeral-p))
|
||||
(setq nnweb-group group
|
||||
nnweb-articles nil)
|
||||
(let ((info (assoc group nnweb-group-alist)))
|
||||
(when info
|
||||
(setq nnweb-type (nth 2 info))
|
||||
(setq nnweb-search (nth 3 info))
|
||||
(unless dont-check
|
||||
(nnweb-read-overview group)))))
|
||||
(nnweb-possibly-change-server group server)
|
||||
(unless (or nnweb-ephemeral-p
|
||||
dont-check)
|
||||
(nnweb-read-overview group))
|
||||
(cond
|
||||
((not nnweb-articles)
|
||||
(nnheader-report 'nnweb "No matching articles"))
|
||||
|
|
@ -205,7 +198,7 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
(nnweb-possibly-change-server nil server)
|
||||
(save-excursion
|
||||
(set-buffer nntp-server-buffer)
|
||||
(nnmail-generate-active nnweb-group-alist)
|
||||
(nnmail-generate-active (list (assoc server nnweb-group-alist)))
|
||||
t))
|
||||
|
||||
(deffoo nnweb-request-update-info (group info &optional server)
|
||||
|
|
@ -217,7 +210,7 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
(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) ,@args) nnweb-group-alist)
|
||||
(push `(,group ,(cons 1 0)) nnweb-group-alist)
|
||||
(nnweb-write-active)
|
||||
t)
|
||||
|
||||
|
|
@ -287,18 +280,16 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
def))
|
||||
|
||||
(defun nnweb-possibly-change-server (&optional group server)
|
||||
(nnweb-init server)
|
||||
(when server
|
||||
(unless (nnweb-server-opened server)
|
||||
(nnweb-open-server 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
|
||||
(when (and (not nnweb-ephemeral-p)
|
||||
(equal group nnweb-group))
|
||||
(nnweb-request-group group nil t))))
|
||||
(setq nnweb-group group)))
|
||||
|
||||
(defun nnweb-init (server)
|
||||
"Initialize buffers and such."
|
||||
|
|
@ -337,22 +328,27 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
(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-type nnweb-search)
|
||||
(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=/groups\\(\\?[^ \">]*selm=\\([^ &\">]+\\)\\)" nil t)
|
||||
(setq mid (match-string 2)
|
||||
(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 'id) mid))
|
||||
(nnweb-definition 'result) Newsgroups mid))
|
||||
(narrow-to-region (search-forward ">" nil t)
|
||||
(search-forward "</a>" nil t))
|
||||
(mm-url-remove-markup)
|
||||
|
|
@ -360,25 +356,22 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
(setq Subject (buffer-string))
|
||||
(goto-char (point-max))
|
||||
(widen)
|
||||
(forward-line 2)
|
||||
(when (looking-at "<br><font[^>]+>")
|
||||
(goto-char (match-end 0)))
|
||||
(if (not (looking-at "<a[^>]+>"))
|
||||
(skip-chars-forward " \t")
|
||||
(narrow-to-region (point)
|
||||
(search-forward "</a>" nil t))
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities)
|
||||
(setq Newsgroups (buffer-string))
|
||||
(goto-char (point-max))
|
||||
(widen)
|
||||
(skip-chars-forward "- \t"))
|
||||
(narrow-to-region (point)
|
||||
(search-forward "</td" nil t))
|
||||
|
||||
(mm-url-remove-markup)
|
||||
(mm-url-decode-entities)
|
||||
(search-backward " - ")
|
||||
(when (looking-at
|
||||
"\\([0-9]+\\)[/ ]\\([A-Za-z]+\\)[/ ]\\([0-9]+\\)[ \t]*by[ \t]*\\([^<]*\\) - <a")
|
||||
" - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?, [^\n]+by \\([^<\n]+\\)\n")
|
||||
(setq From (match-string 4)
|
||||
Date (format "%s %s 00:00:00 %s"
|
||||
(match-string 2) (match-string 1)
|
||||
(match-string 3))))
|
||||
(match-string 1)
|
||||
(match-string 2)
|
||||
(or (match-string 3)
|
||||
(substring (current-time-string) -4)))))
|
||||
|
||||
(widen)
|
||||
(forward-line 1)
|
||||
(incf i)
|
||||
(unless (nnweb-get-hashtb url)
|
||||
|
|
@ -419,7 +412,7 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
(goto-char (point-min))
|
||||
(incf i 100)
|
||||
(if (or (not (re-search-forward
|
||||
"<td nowrap><a href=\\([^>]+\\).*<span class=b>Next</span>" nil t))
|
||||
"<td><a href=\"\n\\([^>\"]+\\)\"><img src=\"/img/nav_next" nil t))
|
||||
(>= i nnweb-max-hits))
|
||||
(setq more nil)
|
||||
;; Yup, there are more articles
|
||||
|
|
@ -443,7 +436,8 @@ Valid types include `google', `dejanews', and `gmane'.")
|
|||
("hl" . "en")
|
||||
("lr" . "")
|
||||
("safe" . "off")
|
||||
("sites" . "groups")))))
|
||||
("sites" . "groups")
|
||||
("filter" . "0")))))
|
||||
t)
|
||||
|
||||
(defun nnweb-google-identity (url)
|
||||
|
|
|
|||
|
|
@ -113,7 +113,8 @@ With ARG, you are asked to choose which language."
|
|||
(setq val (completing-read (if fn
|
||||
(format "Describe function (default %s): " fn)
|
||||
"Describe function: ")
|
||||
obarray 'fboundp t nil nil (symbol-name fn)))
|
||||
obarray 'fboundp t nil nil
|
||||
(and fn (symbol-name fn))))
|
||||
(list (if (equal val "")
|
||||
fn (intern val)))))
|
||||
(if (null function)
|
||||
|
|
|
|||
|
|
@ -137,11 +137,14 @@ and showing the image as an image."
|
|||
(message "Repeat this command to go back to displaying the image")))
|
||||
;; Turn the image data into a real image, but only if the whole file
|
||||
;; was inserted
|
||||
(let* ((data
|
||||
(string-make-unibyte
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
(image
|
||||
(create-image data nil t))
|
||||
(let* ((image
|
||||
(if (and (buffer-file-name)
|
||||
(not (buffer-modified-p)))
|
||||
(create-image (buffer-file-name))
|
||||
(create-image
|
||||
(string-make-unibyte
|
||||
(buffer-substring-no-properties (point-min) (point-max)))
|
||||
nil t)))
|
||||
(props
|
||||
`(display ,image
|
||||
intangible ,image
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; latexenc.el --- guess correct coding system in LaTeX files
|
||||
;;; latexenc.el --- guess correct coding system in LaTeX files -*-coding: iso-2022-7bit -*-
|
||||
|
||||
;; Copyright (C) 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -167,7 +167,7 @@ coding system names is determined from `latex-inputenc-coding-alist'."
|
|||
(setq latexenc-main-file (tex-guess-main-file)))))
|
||||
;; if we found a master/main file get the coding system from it
|
||||
(if (and latexenc-main-file
|
||||
(file-regular-p latexenc-main-file)
|
||||
(file-regular-p latexenc-main-file)
|
||||
(file-readable-p latexenc-main-file))
|
||||
(let* ((latexenc-dont-use-tex-guess-main-file-flag t)
|
||||
(latexenc-dont-use-TeX-master-flag t)
|
||||
|
|
|
|||
|
|
@ -332,9 +332,8 @@ By default, `identity' is set."
|
|||
(if (looking-at "Summary-line: ")
|
||||
(progn
|
||||
(goto-char (match-end 0))
|
||||
(setq line
|
||||
(buffer-substring (point)
|
||||
(progn (forward-line 1) (point)))))))))
|
||||
(buffer-substring (point)
|
||||
(progn (forward-line 1) (point))))))))
|
||||
;; Obsolete status lines lacking a # should be flushed.
|
||||
(and line
|
||||
(not (string-match "#" line))
|
||||
|
|
|
|||
|
|
@ -82,6 +82,7 @@ WINS=\
|
|||
calendar \
|
||||
emacs-lisp \
|
||||
emulation \
|
||||
erc \
|
||||
eshell \
|
||||
gnus \
|
||||
international \
|
||||
|
|
@ -301,14 +302,18 @@ recompile: mh-autoloads doit $(lisp)/progmodes/cc-mode.elc
|
|||
# the autoloads for the MH-E entry points, which are already in
|
||||
# loaddefs.el.
|
||||
MH_E_SRC = $(lisp)/mh-e/mh-acros.el $(lisp)/mh-e/mh-alias.el \
|
||||
$(lisp)/mh-e/mh-buffers.el $(lisp)/mh-e/mh-comp.el \
|
||||
$(lisp)/mh-e/mh-customize.el $(lisp)/mh-e/mh-e.el \
|
||||
$(lisp)/mh-e/mh-funcs.el $(lisp)/mh-e/mh-identity.el \
|
||||
$(lisp)/mh-e/mh-inc.el $(lisp)/mh-e/mh-init.el \
|
||||
$(lisp)/mh-e/mh-junk.el $(lisp)/mh-e/mh-mime.el \
|
||||
$(lisp)/mh-e/mh-print.el $(lisp)/mh-e/mh-search.el \
|
||||
$(lisp)/mh-e/mh-seq.el $(lisp)/mh-e/mh-speed.el \
|
||||
$(lisp)/mh-e/mh-utils.el
|
||||
$(lisp)/mh-e/mh-buffers.el $(lisp)/mh-e/mh-compat.el \
|
||||
$(lisp)/mh-e/mh-comp.el $(lisp)/mh-e/mh-e.el \
|
||||
$(lisp)/mh-e/mh-folder.el $(lisp)/mh-e/mh-funcs.el \
|
||||
$(lisp)/mh-e/mh-gnus.el $(lisp)/mh-e/mh-identity.el \
|
||||
$(lisp)/mh-e/mh-inc.el $(lisp)/mh-e/mh-junk.el \
|
||||
$(lisp)/mh-e/mh-letter.el $(lisp)/mh-e/mh-limit.el \
|
||||
$(lisp)/mh-e/mh-mime.el $(lisp)/mh-e/mh-print.el \
|
||||
$(lisp)/mh-e/mh-scan.el $(lisp)/mh-e/mh-search.el \
|
||||
$(lisp)/mh-e/mh-seq.el $(lisp)/mh-e/mh-show.el \
|
||||
$(lisp)/mh-e/mh-speed.el $(lisp)/mh-e/mh-thread.el \
|
||||
$(lisp)/mh-e/mh-tool-bar.el $(lisp)/mh-e/mh-utils.el \
|
||||
$(lisp)/mh-e/mh-xface.el
|
||||
|
||||
mh-autoloads: $(lisp)/mh-e/mh-loaddefs.el
|
||||
$(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
|
||||
|
|
|
|||
1
lisp/mh-e/.gitignore
vendored
1
lisp/mh-e/.gitignore
vendored
|
|
@ -1,2 +1,3 @@
|
|||
mh-autoloads.el
|
||||
mh-cus-load.el
|
||||
mh-loaddefs.el
|
||||
|
|
|
|||
|
|
@ -1,3 +1,555 @@
|
|||
2006-01-31 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* mh-acros.el (mh-defun-compat, mh-defmacro-compat): Add name
|
||||
argument since compatibility functions should have our package
|
||||
prefix (mh-) by Emacs convention and to avoid messing up checks
|
||||
for the same functions in other packages. Use explicit argument
|
||||
instead of forming name by adding mh-e prefix so that one can grep
|
||||
and find the definition.
|
||||
|
||||
* mh-alias.el (mh-alias-local-users, mh-alias-reload)
|
||||
(mh-alias-expand, mh-alias-minibuffer-confirm-address): Use
|
||||
mh-assoc-string instead of assoc-string.
|
||||
|
||||
* mh-compat.el (assoc-string): Rename to mh-assoc-string.
|
||||
(mh-mail-abbrev-make-syntax-table, mh-url-hexify-string): Move
|
||||
here from mh-utils.el.
|
||||
(mh-display-completion-list): Move here from mh-comp.el.
|
||||
(mh-face-foreground, mh-face-background): Move here from
|
||||
mh-xface.el.
|
||||
(mh-write-file-functions): Move here from mh-folder.el
|
||||
|
||||
* mh-folder.el (mh-write-file-functions-compat): Move to
|
||||
mh-compat.el and rename to mh-write-file-functions.
|
||||
(mh-folder-mode): Use the new name.
|
||||
|
||||
* mh-gnus.el (gnus-local-map-property): Rename to
|
||||
mh-gnus-local-map-property.
|
||||
(mm-merge-handles): Rename to mh-mm-merge-handles.
|
||||
(mm-set-handle-multipart-parameter): Rename to
|
||||
mh-mm-set-handle-multipart-parameter.
|
||||
(mm-inline-text-vcard): Rename to mh-mm-inline-text-vcard.
|
||||
(mm-possibly-verify-or-decrypt): Rename to
|
||||
mh-mm-possibly-verify-or-decrypt.
|
||||
(mm-handle-multipart-ctl-parameter): Rename to
|
||||
mh-mm-handle-multipart-ctl-parameter.
|
||||
(mm-readable-p): Rename to mh-mm-readable-p.
|
||||
(mm-long-lines-p): Rename to mh-mm-long-lines-p.
|
||||
(mm-keep-viewer-alive-p): Rename to mh-mm-keep-viewer-alive-p.
|
||||
(mm-destroy-parts): Rename to mh-mm-destroy-parts.
|
||||
(mm-uu-dissect-text-parts): Rename to mh-mm-uu-dissect-text-parts.
|
||||
(mml-minibuffer-read-disposition): Rename to
|
||||
mh-mml-minibuffer-read-disposition.
|
||||
|
||||
* mh-identity.el (mh-identity-field-handler): Use mh-assoc-string
|
||||
instead of assoc-string.
|
||||
|
||||
* mh-mime.el (mh-mm-inline-media-tests, mh-mm-inline-message)
|
||||
(mh-mime-display, mh-mime-display-security)
|
||||
(mh-insert-mime-button, mh-insert-mime-security-button)
|
||||
(mh-handle-set-external-undisplayer)
|
||||
(mh-mime-security-press-button, mh-mime-security-show-details)
|
||||
(mh-mml-attach-file, mh-mime-cleanup)
|
||||
(mh-destroy-postponed-handles): Use new mh-* names for
|
||||
compatibility functions.
|
||||
|
||||
* mh-utils.el (mail-abbrev-make-syntax-table): Move to
|
||||
mh-compat.el and rename to mh-mail-abbrev-make-syntax-table.
|
||||
(mh-beginning-of-word): Use the new name.
|
||||
(mh-get-field): Delete ancient alias.
|
||||
|
||||
* mh-xface.el (mh-face-foreground-compat): Move to mh-compat.el
|
||||
and rename to mh-face-foreground
|
||||
(mh-face-background-compat): Move to mh-compat.el
|
||||
and rename to mh-face-background.
|
||||
(mh-face-display-function): Use the new names.
|
||||
(mh-x-image-url-cache-canonicalize): Use mh-url-hexify-string
|
||||
instead of url-hexify-string.
|
||||
(url-unreserved-chars): Move to mh-compat.el and rename to
|
||||
mh-url-unreserved-chars.
|
||||
(url-hexify-string): Move to mh-compat.el and rename to
|
||||
mh-url-hexify-string.
|
||||
|
||||
* mh-letter.el (mh-complete-word): Fix bug in call to
|
||||
mh-display-completion-list. Wrong argument was passed, so
|
||||
completions wouldn't show highlighted prefix.
|
||||
|
||||
2006-01-29 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* mh-e.el (mh-scan-format-file-check): Allow any non-nil for
|
||||
mh-adaptive-cmd-note-flag.
|
||||
|
||||
* mh-comp.el (sc-cite-original): Remove autoload of "sc" with old
|
||||
docstring. sc-cite-original is autoloaded via loaddefs.el for all
|
||||
supported versions. In addition, the package name "sc" has been
|
||||
made obsolete by "supercite since at least Emacs 21.
|
||||
|
||||
* mh-scan.el (mh-note-copied, mh-note-printed): Reorganization
|
||||
revealed character constants that were still strings (closes SF
|
||||
#770772).
|
||||
|
||||
* mh-comp.el (mh-letter-hide-all-skipped-fields)
|
||||
(mh-get-header-field): Move to mh-utils.el so that you can read
|
||||
messages without having to load mh-comp.el and mh-letter.el.
|
||||
|
||||
* mh-letter.el (mh-hidden-header-keymap)
|
||||
(mh-letter-toggle-header-field-display)
|
||||
(mh-letter-skipped-header-field-p)
|
||||
(mh-letter-skip-leading-whitespace-in-header-field)
|
||||
(mh-letter-truncate-header-field): Move to mh-utils.el so that you
|
||||
can read messages without having to load mh-comp.el and
|
||||
mh-letter.el.
|
||||
|
||||
* mh-utils.el (mh-get-header-field)
|
||||
(mh-letter-hide-all-skipped-fields)
|
||||
(mh-letter-skipped-header-field-p, mh-hidden-header-keymap)
|
||||
(mh-letter-toggle-header-field-display)
|
||||
(mh-letter-skip-leading-whitespace-in-header-field)
|
||||
(mh-letter-truncate-header-field): Move here from mh-comp.el and
|
||||
mh-letter.el so that you can read messages without having to load
|
||||
mh-comp.el and mh-letter.el.
|
||||
|
||||
* mh-comp.el (mh-insert-fields): Handle nil values. Rmail, at
|
||||
least, will deliver them to us.
|
||||
|
||||
* mh-e.el (mh-after-commands-processed-hook)
|
||||
(mh-before-commands-processed-hook): Specify what sort of requests
|
||||
in docstring.
|
||||
|
||||
* mh-folder.el (mh-folder-mode): Use add-to-list to modify
|
||||
minor-mode-alias.
|
||||
|
||||
* mh-letter.el (mh-letter-menu): Remove. Defvar no longer needed
|
||||
to shush compiler.
|
||||
(mh-letter-mode): Remove Mail menu.
|
||||
|
||||
2006-01-29 Bill Wohler <wohler@newt.com>
|
||||
|
||||
The Great Cleanup
|
||||
Remove circular dependencies. mh-e.el now includes few require
|
||||
statements and stands alone. Other files should need to require
|
||||
mh-e.el, which requires mh-loaddefs.el, plus variable-only files
|
||||
such as mh-scan.el.
|
||||
Remove unneeded require statements.
|
||||
Remove unneeded load statements, or replace them with non-fatal
|
||||
require statements.
|
||||
Break out components into their own files that were often spread
|
||||
between many files.
|
||||
As a result, many functions that are now only used within a single
|
||||
file no longer need to be autoloaded.
|
||||
Rearrange and provide consistent headings.
|
||||
Untabify.
|
||||
|
||||
* mh-acros.el: Update commentary to reflect current usage. Add
|
||||
autoload cookies to all macros.
|
||||
(mh-require-cl): Merge docstring and comment.
|
||||
(mh-do-in-xemacs): Fix typo in docstring.
|
||||
(assoc-string): Move to new file mh-compat.el.
|
||||
(with-mh-folder-updating, mh-in-show-buffer)
|
||||
(mh-do-at-event-location, mh-seq-msgs): Move here from
|
||||
mh-utils.el.
|
||||
(mh-iterate-on-messages-in-region, mh-iterate-on-range): Move here
|
||||
from mh-seq.el.
|
||||
|
||||
* mh-alias.el (mh-address-mail-regexp)
|
||||
(mh-goto-address-find-address-at-point): Move here from
|
||||
mh-utils.el.
|
||||
(mh-folder-line-matches-show-buffer-p): Move here from mh-e.el.
|
||||
|
||||
* mh-buffers.el: Update descriptive text.
|
||||
|
||||
* mh-comp.el (mh-note-repl, mh-note-forw, mh-note-dist): Move to
|
||||
new file mh-scan.el.
|
||||
(mh-yank-hooks, mh-to-field-choices, mh-position-on-field)
|
||||
(mh-letter-menu, mh-letter-mode-help-messages)
|
||||
(mh-letter-buttons-init-flag, mh-letter-mode)
|
||||
(mh-font-lock-field-data, mh-letter-header-end)
|
||||
(mh-auto-fill-for-letter, mh-to-field, mh-to-fcc)
|
||||
(mh-file-is-vcard-p, mh-insert-signature, mh-check-whom)
|
||||
(mh-insert-letter, mh-extract-from-attribution, mh-yank-cur-msg)
|
||||
(mh-filter-out-non-text, mh-insert-prefix-string)
|
||||
(mh-current-fill-prefix, mh-open-line, mh-complete-word)
|
||||
(mh-folder-expand-at-point, mh-letter-complete-function-alist)
|
||||
(mh-letter-complete, mh-letter-complete-or-space)
|
||||
(mh-letter-confirm-address, mh-letter-header-field-at-point)
|
||||
(mh-letter-next-header-field-or-indent)
|
||||
(mh-letter-next-header-field, mh-letter-previous-header-field)
|
||||
(mh-letter-skipped-header-field-p)
|
||||
(mh-letter-skip-leading-whitespace-in-header-field)
|
||||
(mh-hidden-header-keymap)
|
||||
(mh-letter-toggle-header-field-display-button)
|
||||
(mh-letter-toggle-header-field-display)
|
||||
(mh-letter-truncate-header-field, mh-letter-mode-map): Move to new
|
||||
file mh-letter.el.
|
||||
(mh-letter-mode-map, mh-sent-from-folder, mh-send-args)
|
||||
(mh-pgp-support-flag, mh-x-mailer-string)
|
||||
(mh-letter-header-field-regexp): Move to mh-e.el.
|
||||
(mh-goto-header-field, mh-goto-header-end)
|
||||
(mh-extract-from-header-value, mh-beginning-of-word): Move to
|
||||
mh-utils.el.
|
||||
(mh-insert-header-separator): Move to mh-comp.el.
|
||||
(mh-display-completion-list-compat): Move to new file
|
||||
mh-compat.el.
|
||||
|
||||
* mh-compat.el: New file.
|
||||
(assoc-string): Move here from mh-acros.el.
|
||||
(mh-display-completion-list): Move here from mh-comp.el.
|
||||
|
||||
* mh-customize.el: Move content into mh-e.el and remove.
|
||||
|
||||
* mh-e.el (mh-folder-mode-map, mh-folder-seq-tool-bar-map)
|
||||
(mh-folder-tool-bar-map, mh-inc-spool-map, mh-letter-mode-map)
|
||||
(mh-letter-tool-bar-map, mh-search-mode-map, mh-show-mode-map)
|
||||
(mh-show-seq-tool-bar-map, mh-show-tool-bar-map): All maps now
|
||||
declared here so that they can be used in docstrings.
|
||||
(mh-sent-from-folder, mh-sent-from-msg)
|
||||
(mh-letter-header-field-regexp, mh-pgp-support-flag)
|
||||
(mh-x-mailer-string): Move here from mh-comp.el.
|
||||
(mh-folder-line-matches-show-buffer-p): Move to mh-alias.el.
|
||||
(mh-thread-scan-line-map, mh-thread-scan-line-map-stack): Move
|
||||
here from mh-seq.el.
|
||||
(mh-draft-folder, mh-inbox, mh-user-path, mh-current-folder)
|
||||
(mh-previous-window-config, mh-seen-list, mh-seq-list)
|
||||
(mh-show-buffer, mh-showing-mode, mh-globals-hash)
|
||||
(mh-show-folder-buffer, mh-mail-header-separator)
|
||||
(mh-unseen-seq, mh-previous-seq, mh-page-to-next-msg-flag)
|
||||
(mh-signature-separator, mh-signature-separator-regexp)
|
||||
(mh-list-to-string, mh-list-to-string-1): Move here from
|
||||
mh-utils.el.
|
||||
(mh-index-max-cmdline-args, mh-xargs, mh-quote-for-shell)
|
||||
(mh-exec-cmd, mh-exec-cmd-error, mh-exec-cmd-daemon)
|
||||
(mh-exec-cmd-env-daemon, mh-process-daemon, mh-exec-cmd-quiet)
|
||||
(mh-exec-cmd-output)
|
||||
(mh-exchange-point-and-mark-preserving-active-mark)
|
||||
(mh-exec-lib-cmd-output, mh-handle-process-error): Move here from
|
||||
deprecated file mh-exec.el.
|
||||
(mh-path): Move here from deprecated file mh-customize.el.
|
||||
(mh-sys-path, mh-variants, mh-variant-in-use, mh-progs, mh-lib)
|
||||
(mh-flists-present-flag, mh-variants, mh-variant-mh-info)
|
||||
(mh-variant-mu-mh-info, mh-variant-nmh-info, mh-file-command-p)
|
||||
(mh-variant-set-variant, mh-variant-p, mh-profile-component)
|
||||
(mh-profile-component-value, mh-defface-compat): Move here from
|
||||
deprecated file mh-init.el.
|
||||
(mh-goto-next-button, mh-folder-mime-action)
|
||||
(mh-folder-toggle-mime-part, mh-folder-inline-mime-part)
|
||||
(mh-folder-save-mime-part, mh-toggle-mime-buttons): Move to to
|
||||
mh-mime.el.
|
||||
(mh-scan-format-mh, mh-scan-format-nmh, mh-note-deleted)
|
||||
(mh-note-refiled, mh-note-cur, mh-scan-good-msg-regexp)
|
||||
(mh-scan-deleted-msg-regexp, mh-scan-refiled-msg-regexp)
|
||||
(mh-scan-valid-regexp, mh-scan-cur-msg-number-regexp)
|
||||
(mh-scan-date-regexp, mh-scan-rcpt-regexp, mh-scan-body-regexp)
|
||||
(mh-scan-subject-regexp, mh-scan-sent-to-me-sender-regexp)
|
||||
(mh-scan-cmd-note-width, mh-scan-destination-width)
|
||||
(mh-scan-date-width, mh-scan-date-flag-width)
|
||||
(mh-scan-from-mbox-width, mh-scan-from-mbox-sep-width)
|
||||
(mh-scan-field-destination-offset)
|
||||
(mh-scan-field-from-start-offset, mh-scan-field-from-end-offset)
|
||||
(mh-scan-field-subject-start-offset, mh-scan-format)
|
||||
(mh-msg-num-width-to-column, mh-set-cmd-note): Move to new file
|
||||
mh-scan.el.
|
||||
(mh-partial-folder-mode-line-annotation)
|
||||
(mh-folder-font-lock-keywords, mh-folder-font-lock-subject)
|
||||
(mh-generate-sequence-font-lock, mh-last-destination)
|
||||
(mh-last-destination-write, mh-first-msg-num, mh-last-msg-num)
|
||||
(mh-rmail, mh-nmail, mh-delete-msg, mh-delete-msg-no-motion)
|
||||
(mh-execute-commands, mh-first-msg, mh-header-display)
|
||||
(mh-inc-folder, mh-last-msg, mh-next-undeleted-msg)
|
||||
(mh-folder-from-address, mh-prompt-for-refile-folder)
|
||||
(mh-refile-msg, mh-refile-or-write-again, mh-quit, mh-page-msg)
|
||||
(mh-previous-page, mh-previous-undeleted-msg)
|
||||
(mh-previous-unread-msg, mh-next-button, mh-prev-button)
|
||||
(mh-reset-threads-and-narrowing, mh-rescan-folder)
|
||||
(mh-write-msg-to-file, mh-toggle-showing, mh-undo)
|
||||
(mh-visit-folder, mh-update-sequences, mh-delete-a-msg)
|
||||
(mh-refile-a-msg, mh-next-msg, mh-next-unread-msg)
|
||||
(mh-set-scan-mode, mh-undo-msg, mh-make-folder)
|
||||
(mh-folder-sequence-menu, mh-folder-message-menu)
|
||||
(mh-folder-folder-menu, mh-remove-xemacs-horizontal-scrollbar)
|
||||
(mh-write-file-functions-compat, mh-folder-mode)
|
||||
(mh-restore-desktop-buffer, mh-scan-folder)
|
||||
(mh-regenerate-headers, mh-generate-new-cmd-note)
|
||||
(mh-get-new-mail, mh-make-folder-mode-line, mh-goto-cur-msg)
|
||||
(mh-process-or-undo-commands, mh-process-commands)
|
||||
(mh-update-unseen, mh-delete-scan-msgs)
|
||||
(mh-outstanding-commands-p): Move to new file mh-folder.el.
|
||||
(mh-mapc, mh-colors-available-p, mh-colors-in-use-p)
|
||||
(mh-make-local-vars, mh-coalesce-msg-list, mh-greaterp)
|
||||
(mh-lessp): Move to mh-utils.el.
|
||||
(mh-parse-flist-output-line, mh-folder-size-folder)
|
||||
(mh-folder-size-flist, mh-folder-size, mh-add-sequence-notation)
|
||||
(mh-remove-sequence-notation, mh-remove-cur-notation)
|
||||
(mh-remove-all-notation, mh-delete-seq-locally)
|
||||
(mh-read-folder-sequences, mh-read-msg-list)
|
||||
(mh-notate-user-sequences, mh-internal-seqs, mh-internal-seq)
|
||||
(mh-valid-seq-p, mh-delete-msg-from-seq, mh-catchup)
|
||||
(mh-delete-a-msg-from-seq, mh-undefine-sequence)
|
||||
(mh-define-sequence, mh-seq-containing-msg): Move to mh-seq.el.
|
||||
(mh-xemacs-flag)
|
||||
(mh-customize, mh-e, mh-alias, mh-folder, mh-folder-selection)
|
||||
(mh-identity, mh-inc, mh-junk, mh-letter, mh-ranges)
|
||||
(mh-scan-line-formats, mh-search, mh-sending-mail, mh-sequences)
|
||||
(mh-show, mh-speedbar, mh-thread, mh-tool-bar, mh-hooks)
|
||||
(mh-faces, mh-alias-completion-ignore-case-flag)
|
||||
(mh-alias-expand-aliases-flag, mh-alias-flash-on-comma)
|
||||
(mh-alias-insert-file, mh-alias-insertion-location)
|
||||
(mh-alias-local-users, mh-alias-local-users-prefix)
|
||||
(mh-alias-passwd-gecos-comma-separator-flag)
|
||||
(mh-new-messages-folders, mh-ticked-messages-folders)
|
||||
(mh-large-folder, mh-recenter-summary-flag)
|
||||
(mh-recursive-folders-flag, mh-sortm-args)
|
||||
(mh-default-folder-for-message-function, mh-default-folder-list)
|
||||
(mh-default-folder-must-exist-flag, mh-default-folder-prefix)
|
||||
(mh-identity-list, mh-auto-fields-list)
|
||||
(mh-auto-fields-prompt-flag, mh-identity-default)
|
||||
(mh-identity-handlers, mh-inc-prog, mh-inc-spool-list)
|
||||
(mh-junk-choice, mh-junk-function-alist, mh-junk-choose)
|
||||
(mh-junk-background, mh-junk-disposition, mh-junk-program)
|
||||
(mh-compose-insertion, mh-compose-skipped-header-fields)
|
||||
(mh-compose-space-does-completion-flag)
|
||||
(mh-delete-yanked-msg-window-flag)
|
||||
(mh-extract-from-attribution-verb, mh-ins-buf-prefix)
|
||||
(mh-letter-complete-function, mh-letter-fill-column)
|
||||
(mh-mml-method-default, mh-signature-file-name)
|
||||
(mh-signature-separator-flag, mh-x-face-file, mh-yank-behavior)
|
||||
(mh-interpret-number-as-range-flag, mh-adaptive-cmd-note-flag)
|
||||
(mh-scan-format-file-check, mh-scan-format-file)
|
||||
(mh-adaptive-cmd-note-flag-check, mh-scan-prog)
|
||||
(mh-search-program, mh-compose-forward-as-mime-flag)
|
||||
(mh-compose-letter-function, mh-compose-prompt-flag)
|
||||
(mh-forward-subject-format, mh-insert-x-mailer-flag)
|
||||
(mh-redist-full-contents-flag, mh-reply-default-reply-to)
|
||||
(mh-reply-show-message-flag, mh-refile-preserves-sequences-flag)
|
||||
(mh-tick-seq, mh-update-sequences-after-mh-show-flag)
|
||||
(mh-bury-show-buffer-flag, mh-clean-message-header-flag)
|
||||
(mh-decode-mime-flag, mh-display-buttons-for-alternatives-flag)
|
||||
(mh-display-buttons-for-inline-parts-flag)
|
||||
(mh-do-not-confirm-flag, mh-fetch-x-image-url)
|
||||
(mh-graphical-smileys-flag, mh-graphical-emphasis-flag)
|
||||
(mh-highlight-citation-style)
|
||||
(mh-invisible-header-fields-internal)
|
||||
(mh-delay-invisible-header-generation-flag)
|
||||
(mh-invisible-header-fields, mh-invisible-header-fields-default)
|
||||
(mh-invisible-header-fields-compiled, mh-invisible-headers)
|
||||
(mh-lpr-command-format, mh-max-inline-image-height)
|
||||
(mh-max-inline-image-width, mh-mhl-format-file)
|
||||
(mh-mime-save-parts-default-directory, mh-print-background-flag)
|
||||
(mh-show-maximum-size, mh-show-use-goto-addr-flag)
|
||||
(mh-show-use-xface-flag, mh-store-default-directory)
|
||||
(mh-summary-height, mh-speed-update-interval)
|
||||
(mh-show-threads-flag, mh-tool-bar-search-function)
|
||||
(mh-after-commands-processed-hook, mh-alias-reloaded-hook)
|
||||
(mh-before-commands-processed-hook, mh-before-quit-hook)
|
||||
(mh-before-send-letter-hook, mh-delete-msg-hook)
|
||||
(mh-find-path-hook, mh-folder-mode-hook, mh-forward-hook)
|
||||
(mh-inc-folder-hook, mh-insert-signature-hook)
|
||||
(mh-kill-folder-suppress-prompt-hooks, mh-letter-mode-hook)
|
||||
(mh-mh-to-mime-hook, mh-search-mode-hook, mh-quit-hook)
|
||||
(mh-refile-msg-hook, mh-show-hook, mh-show-mode-hook)
|
||||
(mh-unseen-updated-hook, mh-min-colors-defined-flag)
|
||||
(mh-folder-address, mh-folder-body)
|
||||
(mh-folder-cur-msg-number, mh-folder-date, mh-folder-deleted)
|
||||
(mh-folder-followup, mh-folder-msg-number, mh-folder-refiled)
|
||||
(mh-folder-sent-to-me-hint, mh-folder-sent-to-me-sender)
|
||||
(mh-folder-subject, mh-folder-tick, mh-folder-to)
|
||||
(mh-search-folder, mh-letter-header-field, mh-show-cc)
|
||||
(mh-show-date, mh-show-from, mh-show-header, mh-show-pgg-bad)
|
||||
(mh-show-pgg-good, mh-show-pgg-unknown, mh-show-signature)
|
||||
(mh-show-subject, mh-show-to, mh-show-xface, mh-speedbar-folder)
|
||||
(mh-speedbar-folder-with-unseen-messages)
|
||||
(mh-speedbar-selected-folder)
|
||||
(mh-speedbar-selected-folder-with-unseen-messages): Move here from
|
||||
deprecated file mh-customize.el.
|
||||
|
||||
* mh-exec.el: Move content into mh-e.el and remove.
|
||||
|
||||
* mh-folder.el: New file. Contains mh-folder-mode from mh-e.el
|
||||
|
||||
* mh-funcs.el (mh-note-copied, mh-note-printed): Move to new file
|
||||
mh-scan.el.
|
||||
(mh-ephem-message, mh-help, mh-prefix-help): Move to mh-utils.el.
|
||||
|
||||
* mh-gnus.el (mm-uu-dissect-text-parts): Add.
|
||||
(mh-mail-abbrev-make-syntax-table): Move to mh-utils.el and rename
|
||||
to mail-abbrev-make-syntax-table.
|
||||
|
||||
* mh-identity.el (mh-identity-menu): New variable for existing
|
||||
menu.
|
||||
(mh-identity-make-menu-no-autoload): New alias for
|
||||
mh-identity-make-menu which can be called from mh-e.el.
|
||||
(mh-identity-list-set): Move to mh-e.el.
|
||||
(mh-identity-add-menu): New function
|
||||
(mh-insert-identity): Add optional argument maybe-insert so that
|
||||
local variable mh-identity-local does not have to be visible.
|
||||
(mh-identity-handler-default):
|
||||
|
||||
* mh-inc.el (mh-inc-spool-map): Move declaration to mh-e.el (with
|
||||
rest of keymaps). Update key binding for ? to call mh-help with
|
||||
help messages in new argument.
|
||||
(mh-inc-spool-make-no-autoload): New alias for mh-inc-spool-make
|
||||
which can be called from mh-e.el.
|
||||
(mh-inc-spool-list-set): Simplify update of mh-inc-spool-map-help.
|
||||
|
||||
* mh-init.el: Move content into mh-e.el and remove.
|
||||
|
||||
* mh-junk.el: Update requires, untabify, and add mh-autoload
|
||||
cookies.
|
||||
|
||||
* mh-letter.el: New file. Contains mh-letter-mode from mh-comp.el.
|
||||
|
||||
* mh-limit.el: New file. Contains display limit commands from
|
||||
mh-mime.el.
|
||||
|
||||
* mh-mime.el: Rearrange for consistency with other files.
|
||||
(mh-buffer-data, mh-mm-inline-media-tests): Move here from
|
||||
mh-utils.el.
|
||||
(mh-folder-inline-mime-part, mh-folder-save-mime-part)
|
||||
(mh-folder-toggle-mime-part, mh-toggle-mime-buttons)
|
||||
(mh-goto-next-button): Move here from mh-e.el.
|
||||
|
||||
* mh-print.el: Rearrange for consistency with other files.
|
||||
|
||||
* mh-scan.el: New file. Contains scan line constants and utilities
|
||||
from XXX, mh-funcs, mh-utils.el.
|
||||
|
||||
* mh-search.el: Rearrange for consistency with other files.
|
||||
(mh-search-mode-map): Drop C-c C-f {dr} bindings since these
|
||||
fields which don't exist in the saved header. Replace C-c C-f f
|
||||
with C-c C-f m per mail-mode consistency.
|
||||
(mh-search-mode): Use mh-set-help instead of setting
|
||||
mh-help-messages.
|
||||
|
||||
* mh-seq.el (mh-thread-message, mh-thread-container)
|
||||
(mh-thread-id-hash, mh-thread-subject-hash, mh-thread-id-table)
|
||||
(mh-thread-id-index-map, mh-thread-index-id-map)
|
||||
(mh-thread-scan-line-map, mh-thread-scan-line-map-stack)
|
||||
(mh-thread-subject-container-hash, mh-thread-duplicates)
|
||||
(mh-thread-history, mh-thread-body-width)
|
||||
(mh-thread-find-msg-subject mh-thread-initialize-hash)
|
||||
(mh-thread-initialize, mh-thread-id-container)
|
||||
(mh-thread-remove-parent-link, mh-thread-add-link)
|
||||
(mh-thread-ancestor-p, mh-thread-get-message-container)
|
||||
(mh-thread-get-message, mh-thread-canonicalize-id)
|
||||
(mh-thread-prune-subject, mh-thread-container-subject)
|
||||
(mh-thread-rewind-pruning, mh-thread-prune-containers)
|
||||
(mh-thread-sort-containers, mh-thread-group-by-subject)
|
||||
(mh-thread-process-in-reply-to, mh-thread-set-tables)
|
||||
(mh-thread-update-id-index-maps, mh-thread-generate)
|
||||
(mh-thread-inc, mh-thread-generate-scan-lines)
|
||||
(mh-thread-parse-scan-line, mh-thread-update-scan-line-map)
|
||||
(mh-thread-add-spaces, mh-thread-print-scan-lines)
|
||||
(mh-thread-folder, mh-toggle-threads, mh-thread-forget-message)
|
||||
(mh-thread-current-indentation-level, mh-thread-next-sibling)
|
||||
(mh-thread-previous-sibling, mh-thread-immediate-ancestor)
|
||||
(mh-thread-ancestor, mh-thread-find-children)
|
||||
(mh-message-id-regexp, mh-thread-delete, mh-thread-refile): Move
|
||||
to new file mh-thread.el.
|
||||
(mh-subject-to-sequence, mh-subject-to-sequence-unthreaded)
|
||||
(mh-subject-to-sequence-threaded, mh-edit-pick-expr)
|
||||
(mh-pick-args-list, mh-narrow-to-subject, mh-narrow-to-from)
|
||||
(mh-narrow-to-cc, mh-narrow-to-to, mh-narrow-to-header-field)
|
||||
(mh-current-message-header-field, mh-narrow-to-range)
|
||||
(mh-delete-subject, mh-delete-subject-or-thread): Move to new file
|
||||
mh-limit.el.
|
||||
(mh-iterate-on-messages-in-region, mh-iterate-on-range): Move to
|
||||
mh-acros.el.
|
||||
(mh-internal-seqs, mh-catchup, mh-delete-msg-from-seq)
|
||||
(mh-internal-seq, mh-valid-seq-p, mh-seq-containing-msg)
|
||||
(mh-define-sequence, mh-undefine-sequence)
|
||||
(mh-delete-a-msg-from-seq, mh-delete-seq-locally)
|
||||
(mh-folder-size, mh-folder-size-flist, mh-folder-size-folder)
|
||||
(mh-parse-flist-output-line, mh-read-folder-sequences)
|
||||
(mh-read-msg-list, mh-notate-user-sequences)
|
||||
(mh-remove-cur-notation, mh-add-sequence-notation)
|
||||
(mh-remove-sequence-notation, mh-remove-all-notation): Move here
|
||||
from mh-e.el.
|
||||
(mh-make-seq, mh-seq-name, mh-find-seq, mh-seq-to-msgs)
|
||||
(mh-add-msgs-to-seq, mh-notate): Move here from mh-utils.el.
|
||||
|
||||
* mh-show.el: New file. Contains mh-show-mode from mh-utils.el.
|
||||
|
||||
* mh-speed.el: Rearrange for consistency with other files.
|
||||
|
||||
* mh-thread.el: New file. Contains threading code from mh-seq.el.
|
||||
|
||||
* mh-tool-bar.el: New file. Contains tool bar creation code from
|
||||
deprecated file mh-customize.el.
|
||||
|
||||
* mh-utils.el (recursive-load-depth-limit): Remove setting. No
|
||||
longer needed.
|
||||
(mh-scan-msg-number-regexp, mh-scan-msg-overflow-regexp)
|
||||
(mh-scan-msg-format-regexp, mh-scan-msg-format-string)
|
||||
(mh-scan-msg-search-regexp, mh-cmd-note, mh-note-seq)
|
||||
(mh-update-scan-format, mh-msg-num-width): Move to new file
|
||||
mh-scan.el.
|
||||
(mh-show-buffer-mode-line-buffer-id, mh-letter-header-font-lock)
|
||||
(mh-header-field-font-lock, mh-header-to-font-lock)
|
||||
(mh-header-cc-font-lock, mh-header-subject-font-lock)
|
||||
(mh-show-font-lock-keywords)
|
||||
(mh-show-font-lock-keywords-with-cite)
|
||||
(mh-show-font-lock-fontify-region)
|
||||
(mh-gnus-article-highlight-citation, mh-showing-with-headers)
|
||||
(mh-start-of-uncleaned-message, mh-invalidate-show-buffer)
|
||||
(mh-unvisit-file, mh-defun-show-buffer, mh-show-mode-map)
|
||||
(mh-show-sequence-menu, mh-show-message-menu)
|
||||
(mh-show-folder-menu, mh-show-mode, mh-show-addr)
|
||||
(mh-maybe-show, mh-show, mh-show-msg, mh-show-unquote-From)
|
||||
(mh-msg-folder, mh-display-msg, mh-clean-msg-header): Move to new
|
||||
file mh-show.el.
|
||||
(mh-mail-header-separator, mh-signature-separator-regexp)
|
||||
(mh-signature-separator, mh-globals-hash, mh-user-path)
|
||||
(mh-draft-folder, mh-unseen-seq, mh-previous-seq, mh-inbox)
|
||||
(mh-previous-window-config, mh-current-folder mh-show-buffer)
|
||||
(mh-showing-mode, mh-show-mode-map, mh-show-folder-buffer)
|
||||
(mh-showing-mode, mh-seq-list, mh-seen-list, mh-summary-height)
|
||||
(mh-list-to-string, mh-list-to-string-1): Move to mh-e.el.
|
||||
(mh-buffer-data, mh-mm-inline-media-tests): Move to mh-mime.el.
|
||||
(mh-address-mail-regexp, mh-goto-address-find-address-at-point):
|
||||
Move to mh-alias.el.
|
||||
(mh-letter-font-lock-keywords): Move to new file mh-letter.el.
|
||||
(mh-folder-filename, mh-msg-count, mh-recenter, mh-msg-filename)
|
||||
(mh-show-mouse, mh-modify, mh-goto-msg, mh-set-folder-modified-p):
|
||||
Move to new file mh-folder.el.
|
||||
(with-mh-folder-updating, mh-in-show-buffer)
|
||||
(mh-do-at-event-location, mh-seq-msgs): Moved to mh-acros.el.
|
||||
(mh-make-seq, mh-seq-name, mh-notate, mh-find-seq)
|
||||
(mh-seq-to-msgs, mh-add-msgs-to-seq, mh-canonicalize-sequence):
|
||||
Moved to mh-seq.el.
|
||||
(mh-show-xface-function, mh-uncompface-executable, mh-face-to-png)
|
||||
(mh-uncompface, mh-icontopbm, mh-face-foreground-compat)
|
||||
(mh-face-background-compat, mh-face-display-function)
|
||||
(mh-show-xface, mh-picon-directory-list)
|
||||
(mh-picon-existing-directory-list)
|
||||
(mh-picon-cache, mh-picon-image-types)
|
||||
(mh-picon-set-directory-list, mh-picon-get-image)
|
||||
(mh-picon-file-contents, mh-picon-generate-path)
|
||||
(mh-x-image-cache-directory, mh-x-image-scaling-function)
|
||||
(mh-wget-executable, mh-wget-choice, mh-wget-option)
|
||||
(mh-x-image-temp-file, mh-x-image-url, mh-x-image-marker)
|
||||
(mh-x-image-url-cache-file, mh-x-image-scale-with-pnm)
|
||||
(mh-x-image-scale-with-convert)
|
||||
(url-unreserved-chars, url-hexify-string)
|
||||
(mh-x-image-url-cache-canonicalize)
|
||||
(mh-x-image-set-download-state, mh-x-image-get-download-state)
|
||||
(mh-x-image-url-fetch-image, mh-x-image-display)
|
||||
(mh-x-image-scale-and-display, mh-x-image-url-sane-p)
|
||||
(mh-x-image-url-display): Move to new file mh-xface.el.
|
||||
(mh-logo-display): Call mh-image-load-path.
|
||||
(mh-find-path-run, mh-find-path): Move here from deprecated file
|
||||
mh-init.el.
|
||||
(mh-help-messages): Now an alist of modes to an alist of messages.
|
||||
(mh-set-help): New function used to set mh-help-messages
|
||||
(mh-help): Adjust for new format of mh-help-messages. Add
|
||||
help-messages argument.
|
||||
(mh-prefix-help): Refactor to use mh-help.
|
||||
(mh-coalesce-msg-list, mh-greaterp, mh-lessp): Move here from
|
||||
mh-e.el.
|
||||
(mh-clear-sub-folders-cache): New function added to avoid exposing
|
||||
mh-sub-folders-cache variable.
|
||||
|
||||
* mh-xface.el: New file. Contains X-Face and Face header field
|
||||
display routines from mh-utils.el.
|
||||
|
||||
2006-01-17 Bill Wohler <wohler@newt.com>
|
||||
|
||||
* mh-acros.el (assoc-string): Fix typo in argument.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; mh-acros.el --- Macros used in MH-E
|
||||
;;; mh-acros.el --- macros used in MH-E
|
||||
|
||||
;; Copyright (C) 2004, 2006 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -26,74 +26,88 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file contains most, if not all, macros. It is so named with a
|
||||
;; silent "m" so that it is compiled first. Otherwise, "make
|
||||
;; recompile" in CVS Emacs may use compiled files with stale macro
|
||||
;; definitions.
|
||||
;; This file contains all macros that are used in more than one file.
|
||||
;; If you run "make recompile" in CVS Emacs and see the message
|
||||
;; "Source is newer than compiled," it is a sign that macro probably
|
||||
;; needs to be moved here.
|
||||
|
||||
;; This file must always be included like this:
|
||||
;;
|
||||
;; (eval-when-compile (require 'mh-acros))
|
||||
;; Historically, it was so named with a silent "m" so that it would be
|
||||
;; compiled first. Otherwise, "make recompile" in CVS Emacs would use
|
||||
;; compiled files with stale macro definitions. Later, no-byte-compile
|
||||
;; was added to the Local Variables section to avoid this problem and
|
||||
;; because it's pointless to compile a file full of macros. But we
|
||||
;; kept the name.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl)
|
||||
(require 'advice)
|
||||
|
||||
;; The Emacs coding conventions require that the cl package not be required at
|
||||
;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl
|
||||
;; routines in their macro expansions. Use mh-require-cl to provide the cl
|
||||
;; routines in the best way possible.
|
||||
|
||||
|
||||
;;; Compatibility
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-require-cl ()
|
||||
"Macro to load \"cl\" if needed.
|
||||
Some versions of \"cl\" produce code for the expansion of
|
||||
\(setf (gethash ...) ...) that uses functions in \"cl\" at run
|
||||
time. This macro recognizes that and loads \"cl\" where
|
||||
appropriate."
|
||||
|
||||
Emacs coding conventions require that the \"cl\" package not be
|
||||
required at runtime. However, the \"cl\" package in Emacs 21.4
|
||||
and earlier left \"cl\" routines in their macro expansions. In
|
||||
particular, the expansion of (setf (gethash ...) ...) used
|
||||
functions in \"cl\" at run time. This macro recognizes that and
|
||||
loads \"cl\" appropriately."
|
||||
(if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash)
|
||||
`(require 'cl)
|
||||
`(eval-when-compile (require 'cl))))
|
||||
|
||||
;; Macros to generate correct code for different emacs variants
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-do-in-gnu-emacs (&rest body)
|
||||
"Execute BODY if in GNU Emacs."
|
||||
(unless (featurep 'xemacs) `(progn ,@body)))
|
||||
(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-do-in-xemacs (&rest body)
|
||||
"Execute BODY if in GNU Emacs."
|
||||
"Execute BODY if in XEmacs."
|
||||
(when (featurep 'xemacs) `(progn ,@body)))
|
||||
(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-funcall-if-exists (function &rest args)
|
||||
"Call FUNCTION with ARGS as parameters if it exists."
|
||||
(when (fboundp function)
|
||||
`(when (fboundp ',function)
|
||||
(funcall ',function ,@args))))
|
||||
|
||||
(defmacro mh-defun-compat (function arg-list &rest body)
|
||||
"This is a macro to define functions which are not defined.
|
||||
It is used for functions which were added to Emacs recently.
|
||||
If FUNCTION is not defined then it is defined to have argument
|
||||
list, ARG-LIST and body, BODY."
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-defun-compat (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)))
|
||||
(unless defined-p
|
||||
`(defun ,function ,arg-list ,@body))))
|
||||
(if defined-p
|
||||
`(defalias ',name ',function)
|
||||
`(defun ,name ,arg-list ,@body))))
|
||||
(put 'mh-defun-compat 'lisp-indent-function 'defun)
|
||||
|
||||
(defmacro mh-defmacro-compat (function arg-list &rest body)
|
||||
"This is a macro to define functions which are not defined.
|
||||
It is used for macros which were added to Emacs recently.
|
||||
If FUNCTION is not defined then it is defined to have argument
|
||||
list, ARG-LIST and body, BODY."
|
||||
(let ((defined-p (fboundp function)))
|
||||
(unless defined-p
|
||||
`(defmacro ,function ,arg-list ,@body))))
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-defmacro-compat (name macro arg-list &rest body)
|
||||
"Create macro NAME.
|
||||
If MACRO exists, then NAME becomes an alias for MACRO.
|
||||
Otherwise, create macro NAME with ARG-LIST and BODY."
|
||||
(let ((defined-p (fboundp macro)))
|
||||
(if defined-p
|
||||
`(defalias ',name ',macro)
|
||||
`(defmacro ,name ,arg-list ,@body))))
|
||||
(put 'mh-defmacro-compat 'lisp-indent-function 'defun)
|
||||
|
||||
|
||||
|
||||
;;; Miscellaneous
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-make-local-hook (hook)
|
||||
"Make HOOK local if needed.
|
||||
XEmacs and versions of GNU Emacs before 21.1 require
|
||||
|
|
@ -102,6 +116,7 @@ XEmacs and versions of GNU Emacs before 21.1 require
|
|||
(not (get 'make-local-hook 'byte-obsolete-info)))
|
||||
`(make-local-hook ,hook)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-mark-active-p (check-transient-mark-mode-flag)
|
||||
"A macro that expands into appropriate code in XEmacs and nil in GNU Emacs.
|
||||
In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then
|
||||
|
|
@ -114,6 +129,10 @@ check if variable `transient-mark-mode' is active."
|
|||
`(and (boundp 'transient-mark-mode) transient-mark-mode
|
||||
(boundp 'mark-active) mark-active))))
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile (mh-do-in-xemacs (defvar struct) (defvar x) (defvar y)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-defstruct (name-spec &rest fields)
|
||||
"Replacement for `defstruct' from the \"cl\" package.
|
||||
The `defstruct' in the \"cl\" library produces compiler warnings,
|
||||
|
|
@ -150,15 +169,145 @@ more details."
|
|||
(list 'nth ,x z)))
|
||||
(quote ,struct-name))))
|
||||
|
||||
(unless (fboundp 'assoc-string)
|
||||
(defsubst assoc-string (key list case-fold)
|
||||
"Like `assoc' but specifically for strings.
|
||||
Case is ignored if CASE-FOLD is non-nil.
|
||||
This function added by MH-E for Emacs versions that lack
|
||||
`assoc-string', introduced in Emacs 22."
|
||||
(if case-fold
|
||||
(assoc-ignore-case key list)
|
||||
(assoc key list))))
|
||||
;;;###mh-autoload
|
||||
(defmacro with-mh-folder-updating (save-modification-flag &rest body)
|
||||
"Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY).
|
||||
Execute BODY, which can modify the folder buffer without having to
|
||||
worry about file locking or the read-only flag, and return its result.
|
||||
If SAVE-MODIFICATION-FLAG is non-nil, the buffer's modification flag
|
||||
is unchanged, otherwise it is cleared."
|
||||
(setq save-modification-flag (car save-modification-flag)) ; CL style
|
||||
`(prog1
|
||||
(let ((mh-folder-updating-mod-flag (buffer-modified-p))
|
||||
(buffer-read-only nil)
|
||||
(buffer-file-name nil)) ;don't let the buffer get locked
|
||||
(prog1
|
||||
(progn
|
||||
,@body)
|
||||
(mh-set-folder-modified-p mh-folder-updating-mod-flag)))
|
||||
,@(if (not save-modification-flag)
|
||||
'((mh-set-folder-modified-p nil)))))
|
||||
(put 'with-mh-folder-updating 'lisp-indent-hook 'defun)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-in-show-buffer (show-buffer &rest body)
|
||||
"Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY).
|
||||
Display buffer SHOW-BUFFER in other window and execute BODY in it.
|
||||
Stronger than `save-excursion', weaker than `save-window-excursion'."
|
||||
(setq show-buffer (car show-buffer)) ; CL style
|
||||
`(let ((mh-in-show-buffer-saved-window (selected-window)))
|
||||
(switch-to-buffer-other-window ,show-buffer)
|
||||
(if mh-bury-show-buffer-flag (bury-buffer (current-buffer)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
,@body)
|
||||
(select-window mh-in-show-buffer-saved-window))))
|
||||
(put 'mh-in-show-buffer 'lisp-indent-hook 'defun)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-do-at-event-location (event &rest body)
|
||||
"Switch to the location of EVENT and execute BODY.
|
||||
After BODY has been executed return to original window. The
|
||||
modification flag of the buffer in the event window is
|
||||
preserved."
|
||||
(let ((event-window (make-symbol "event-window"))
|
||||
(event-position (make-symbol "event-position"))
|
||||
(original-window (make-symbol "original-window"))
|
||||
(original-position (make-symbol "original-position"))
|
||||
(modified-flag (make-symbol "modified-flag")))
|
||||
`(save-excursion
|
||||
(let* ((,event-window
|
||||
(or (mh-funcall-if-exists posn-window (event-start ,event))
|
||||
(mh-funcall-if-exists event-window ,event)))
|
||||
(,event-position
|
||||
(or (mh-funcall-if-exists posn-point (event-start ,event))
|
||||
(mh-funcall-if-exists event-closest-point ,event)))
|
||||
(,original-window (selected-window))
|
||||
(,original-position (progn
|
||||
(set-buffer (window-buffer ,event-window))
|
||||
(set-marker (make-marker) (point))))
|
||||
(,modified-flag (buffer-modified-p))
|
||||
(buffer-read-only nil))
|
||||
(unwind-protect (progn
|
||||
(select-window ,event-window)
|
||||
(goto-char ,event-position)
|
||||
,@body)
|
||||
(set-buffer-modified-p ,modified-flag)
|
||||
(goto-char ,original-position)
|
||||
(set-marker ,original-position nil)
|
||||
(select-window ,original-window))))))
|
||||
(put 'mh-do-at-event-location 'lisp-indent-hook 'defun)
|
||||
|
||||
|
||||
|
||||
;;; Sequences and Ranges
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-seq-msgs (sequence)
|
||||
"Extract messages from the given SEQUENCE."
|
||||
(list 'cdr sequence))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-iterate-on-messages-in-region (var begin end &rest body)
|
||||
"Iterate over region.
|
||||
|
||||
VAR is bound to the message on the current line as we loop
|
||||
starting from BEGIN till END. In each step BODY is executed.
|
||||
|
||||
If VAR is nil then the loop is executed without any binding."
|
||||
(unless (symbolp var)
|
||||
(error "Can not bind the non-symbol %s" var))
|
||||
(let ((binding-needed-flag var))
|
||||
`(save-excursion
|
||||
(goto-char ,begin)
|
||||
(beginning-of-line)
|
||||
(while (and (<= (point) ,end) (not (eobp)))
|
||||
(when (looking-at mh-scan-valid-regexp)
|
||||
(let ,(if binding-needed-flag `((,var (mh-get-msg-num t))) ())
|
||||
,@body))
|
||||
(forward-line 1)))))
|
||||
(put 'mh-iterate-on-messages-in-region 'lisp-indent-hook 'defun)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defmacro mh-iterate-on-range (var range &rest body)
|
||||
"Iterate an operation over a region or sequence.
|
||||
|
||||
VAR is bound to each message in turn in a loop over RANGE, which
|
||||
can be a message number, a list of message numbers, a sequence, a
|
||||
region in a cons cell, or a MH range (something like last:20) in
|
||||
a string. In each iteration, BODY is executed.
|
||||
|
||||
The parameter RANGE is usually created with
|
||||
`mh-interactive-range' in order to provide a uniform interface to
|
||||
MH-E functions."
|
||||
(unless (symbolp var)
|
||||
(error "Can not bind the non-symbol %s" var))
|
||||
(let ((binding-needed-flag var)
|
||||
(msgs (make-symbol "msgs"))
|
||||
(seq-hash-table (make-symbol "seq-hash-table")))
|
||||
`(cond ((numberp ,range)
|
||||
(when (mh-goto-msg ,range t t)
|
||||
(let ,(if binding-needed-flag `((,var ,range)) ())
|
||||
,@body)))
|
||||
((and (consp ,range)
|
||||
(numberp (car ,range)) (numberp (cdr ,range)))
|
||||
(mh-iterate-on-messages-in-region ,var
|
||||
(car ,range) (cdr ,range)
|
||||
,@body))
|
||||
(t (let ((,msgs (cond ((and ,range (symbolp ,range))
|
||||
(mh-seq-to-msgs ,range))
|
||||
((stringp ,range)
|
||||
(mh-translate-range mh-current-folder
|
||||
,range))
|
||||
(t ,range)))
|
||||
(,seq-hash-table (make-hash-table)))
|
||||
(dolist (msg ,msgs)
|
||||
(setf (gethash msg ,seq-hash-table) t))
|
||||
(mh-iterate-on-messages-in-region v (point-min) (point-max)
|
||||
(when (gethash v ,seq-hash-table)
|
||||
(let ,(if binding-needed-flag `((,var v)) ())
|
||||
,@body))))))))
|
||||
(put 'mh-iterate-on-range 'lisp-indent-hook 'defun)
|
||||
|
||||
(provide 'mh-acros)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; mh-alias.el --- MH-E mail alias completion and expansion
|
||||
;;
|
||||
|
||||
;; Copyright (C) 1994, 1995, 1996, 1997,
|
||||
;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -31,24 +31,9 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
;;(message "> mh-alias")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
(mh-require-cl)
|
||||
(require 'mh-buffers)
|
||||
(require 'mh-e)
|
||||
;;(message "< mh-alias")
|
||||
(load "cmr" t t) ; Non-fatal dependency for
|
||||
; completing-read-multiple.
|
||||
(eval-when-compile (defvar mail-abbrev-syntax-table))
|
||||
|
||||
|
||||
|
||||
;;; Autoloads
|
||||
|
||||
(eval-when (compile load eval)
|
||||
(ignore-errors
|
||||
(require 'mailabbrev)
|
||||
(require 'multi-prompt)))
|
||||
(mh-require-cl)
|
||||
|
||||
(defvar mh-alias-alist 'not-read
|
||||
"Alist of MH aliases.")
|
||||
|
|
@ -61,7 +46,7 @@
|
|||
(defvar mh-alias-read-address-map nil)
|
||||
(unless mh-alias-read-address-map
|
||||
(setq mh-alias-read-address-map
|
||||
(copy-keymap minibuffer-local-completion-map))
|
||||
(copy-keymap minibuffer-local-completion-map))
|
||||
(define-key mh-alias-read-address-map
|
||||
"," 'mh-alias-minibuffer-confirm-address)
|
||||
(define-key mh-alias-read-address-map " " 'self-insert-command))
|
||||
|
|
@ -77,6 +62,11 @@ alias files listed in your \"Aliasfile:\" MH profile component are
|
|||
automatically included. You can update the alias list manually using
|
||||
\\[mh-alias-reload].")
|
||||
|
||||
;; Copy of `goto-address-mail-regexp'.
|
||||
(defvar mh-address-mail-regexp
|
||||
"[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
|
||||
"A regular expression probably matching an e-mail address.")
|
||||
|
||||
|
||||
|
||||
;;; Alias Loading
|
||||
|
|
@ -179,13 +169,12 @@ Exclude all aliases already in `mh-alias-alist' from \"ali\""
|
|||
(if (string-equal username realname)
|
||||
(concat "<" username ">")
|
||||
(concat realname " <" username ">"))))
|
||||
(when (not (assoc-string alias-name mh-alias-alist t))
|
||||
(when (not (mh-assoc-string alias-name mh-alias-alist t))
|
||||
(setq passwd-alist (cons (list alias-name alias-translation)
|
||||
passwd-alist)))))))
|
||||
(forward-line 1)))
|
||||
passwd-alist))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-reload ()
|
||||
"Reload MH aliases.
|
||||
|
||||
|
|
@ -209,12 +198,12 @@ been loaded."
|
|||
(cond
|
||||
((looking-at "^[ \t]")) ;Continuation line
|
||||
((looking-at "\\(.+\\): .+: .*$") ; A new -blind- MH alias
|
||||
(when (not (assoc-string (match-string 1) mh-alias-blind-alist t))
|
||||
(when (not (mh-assoc-string (match-string 1) mh-alias-blind-alist t))
|
||||
(setq mh-alias-blind-alist
|
||||
(cons (list (match-string 1)) mh-alias-blind-alist))
|
||||
(setq mh-alias-alist (cons (list (match-string 1)) mh-alias-alist))))
|
||||
((looking-at "\\(.+\\): .*$") ; A new MH alias
|
||||
(when (not (assoc-string (match-string 1) mh-alias-alist t))
|
||||
(when (not (mh-assoc-string (match-string 1) mh-alias-alist t))
|
||||
(setq mh-alias-alist
|
||||
(cons (list (match-string 1)) mh-alias-alist)))))
|
||||
(forward-line 1)))
|
||||
|
|
@ -225,7 +214,7 @@ been loaded."
|
|||
user)
|
||||
(while local-users
|
||||
(setq user (car local-users))
|
||||
(if (not (assoc-string (car user) mh-alias-alist t))
|
||||
(if (not (mh-assoc-string (car user) mh-alias-alist t))
|
||||
(setq mh-alias-alist (append mh-alias-alist (list user))))
|
||||
(setq local-users (cdr local-users)))))
|
||||
(run-hooks 'mh-alias-reloaded-hook)
|
||||
|
|
@ -262,18 +251,21 @@ returns the string unchanged if not defined. The same is done here."
|
|||
"Return expansion for ALIAS.
|
||||
Blind aliases or users from /etc/passwd are not expanded."
|
||||
(cond
|
||||
((assoc-string alias mh-alias-blind-alist t)
|
||||
((mh-assoc-string alias mh-alias-blind-alist t)
|
||||
alias) ; Don't expand a blind alias
|
||||
((assoc-string alias mh-alias-passwd-alist t)
|
||||
(cadr (assoc-string alias mh-alias-passwd-alist t)))
|
||||
((mh-assoc-string alias mh-alias-passwd-alist t)
|
||||
(cadr (mh-assoc-string alias mh-alias-passwd-alist t)))
|
||||
(t
|
||||
(mh-alias-ali alias))))
|
||||
|
||||
(require 'crm nil t) ; completing-read-multiple
|
||||
(require 'multi-prompt nil t)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-read-address (prompt)
|
||||
"Read an address from the minibuffer with PROMPT."
|
||||
(mh-alias-reload-maybe)
|
||||
(if (not mh-alias-alist) ; If still no aliases, just prompt
|
||||
(if (not mh-alias-alist) ; If still no aliases, just prompt
|
||||
(read-string prompt)
|
||||
(let* ((minibuffer-local-completion-map mh-alias-read-address-map)
|
||||
(completion-ignore-case mh-alias-completion-ignore-case-flag)
|
||||
|
|
@ -300,7 +292,7 @@ Blind aliases or users from /etc/passwd are not expanded."
|
|||
(let* ((case-fold-search t)
|
||||
(beg (mh-beginning-of-word))
|
||||
(the-name (buffer-substring-no-properties beg (point))))
|
||||
(if (assoc-string the-name mh-alias-alist t)
|
||||
(if (mh-assoc-string the-name mh-alias-alist t)
|
||||
(message "%s -> %s" the-name (mh-alias-expand the-name))
|
||||
;; Check if if was a single word likely to be an alias
|
||||
(if (and (equal mh-alias-flash-on-comma 1)
|
||||
|
|
@ -308,8 +300,6 @@ Blind aliases or users from /etc/passwd are not expanded."
|
|||
(message "No alias for %s" the-name))))))
|
||||
(self-insert-command 1))
|
||||
|
||||
(mh-do-in-xemacs (defvar mail-abbrevs))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-letter-expand-alias ()
|
||||
"Expand mail alias before point."
|
||||
|
|
@ -323,9 +313,10 @@ Blind aliases or users from /etc/passwd are not expanded."
|
|||
(expansion (mh-alias-expand (buffer-substring begin end))))
|
||||
(delete-region begin end)
|
||||
(insert expansion)))))
|
||||
|
||||
|
||||
|
||||
;;; Adding addresses to alias file.
|
||||
;;; Alias File Updating
|
||||
|
||||
(defun mh-alias-suggest-alias (string &optional no-comma-swap)
|
||||
"Suggest an alias for STRING.
|
||||
|
|
@ -451,8 +442,8 @@ contains it."
|
|||
(mh-alias-filenames t)))))
|
||||
(cond
|
||||
((not autolist)
|
||||
(error "No writable alias file.
|
||||
Set `mh-alias-insert-file' or the \"Aliasfile:\" profile component"))
|
||||
(error "No writable alias file;
|
||||
set `mh-alias-insert-file' or the \"Aliasfile:\" profile component"))
|
||||
((not (elt autolist 1)) ; Only one entry, use it
|
||||
(car autolist))
|
||||
((or (not alias)
|
||||
|
|
@ -549,7 +540,6 @@ folder name hint when filing messages."
|
|||
(insert (format "%s: %s\n" alias address))
|
||||
(save-buffer)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-add-alias (alias address)
|
||||
"Add ALIAS for ADDRESS in personal alias file.
|
||||
|
||||
|
|
@ -602,7 +592,6 @@ filing messages."
|
|||
(alias (mh-alias-suggest-alias address)))
|
||||
(mh-alias-add-alias alias address))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-alias-add-address-under-point ()
|
||||
"Insert an alias for address under point."
|
||||
(interactive)
|
||||
|
|
@ -611,7 +600,19 @@ filing messages."
|
|||
(mh-alias-add-alias nil address)
|
||||
(message "No email address found under point"))))
|
||||
|
||||
;;;###mh-autoload
|
||||
;; From goto-addr.el, which we don't want to force-load on users.
|
||||
(defun mh-goto-address-find-address-at-point ()
|
||||
"Find e-mail address around or before point.
|
||||
|
||||
Then search backwards to beginning of line for the start of an
|
||||
e-mail address. If no e-mail address found, return nil."
|
||||
(re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim)
|
||||
(if (or (looking-at mh-address-mail-regexp) ; already at start
|
||||
(and (re-search-forward mh-address-mail-regexp
|
||||
(line-end-position) 'lim)
|
||||
(goto-char (match-beginning 0))))
|
||||
(match-string-no-properties 0)))
|
||||
|
||||
(defun mh-alias-apropos (regexp)
|
||||
"Show all aliases or addresses that match a regular expression REGEXP."
|
||||
(interactive "sAlias regexp: ")
|
||||
|
|
@ -668,6 +669,21 @@ filing messages."
|
|||
(princ "\nLocal User Aliases:\n\n")
|
||||
(princ passwd-matches))))))
|
||||
|
||||
(defun mh-folder-line-matches-show-buffer-p ()
|
||||
"Return t if the message under point in folder-mode is in the show buffer.
|
||||
Return nil in any other circumstance (no message under point, no
|
||||
show buffer, the message in the show buffer doesn't match."
|
||||
(and (eq major-mode 'mh-folder-mode)
|
||||
(mh-get-msg-num nil)
|
||||
mh-show-buffer
|
||||
(get-buffer mh-show-buffer)
|
||||
(buffer-file-name (get-buffer mh-show-buffer))
|
||||
(string-match ".*/\\([0-9]+\\)$"
|
||||
(buffer-file-name (get-buffer mh-show-buffer)))
|
||||
(string-equal
|
||||
(match-string 1 (buffer-file-name (get-buffer mh-show-buffer)))
|
||||
(int-to-string (mh-get-msg-num nil)))))
|
||||
|
||||
(provide 'mh-alias)
|
||||
|
||||
;; Local Variables:
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; mh-buffers.el --- Temporary buffer constants and utilities used by MH-E
|
||||
;;; mh-buffers.el --- MH-E buffer constants and utilities
|
||||
|
||||
;; Copyright (C) 1993, 1995, 1997,
|
||||
;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
|
@ -27,8 +27,6 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; Temporary buffer constants and utilities used by MH-E.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
|
|
|||
1704
lisp/mh-e/mh-comp.el
1704
lisp/mh-e/mh-comp.el
File diff suppressed because it is too large
Load diff
133
lisp/mh-e/mh-compat.el
Normal file
133
lisp/mh-e/mh-compat.el
Normal file
|
|
@ -0,0 +1,133 @@
|
|||
;;; mh-compat.el --- make MH-E compatibile with various versions of Emacs
|
||||
|
||||
;; Copyright (C) 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Bill Wohler <wohler@newt.com>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; This is a good place to gather code that is used for compatibility
|
||||
;; between different versions of Emacs. Please document which versions
|
||||
;; of Emacs that the defsubst, defalias, or defmacro applies. That
|
||||
;; way, it's easy to occasionally go through this file and see which
|
||||
;; macros we can retire.
|
||||
|
||||
;; Please use mh-gnus.el when providing compatibility with different
|
||||
;; versions of Gnus and mh-xemacs.el for compatibility with XEmacs.
|
||||
|
||||
;; Items are listed alphabetically.
|
||||
|
||||
(mh-defun-compat mh-assoc-string assoc-string (key list case-fold)
|
||||
"Like `assoc' but specifically for strings.
|
||||
Case is ignored if CASE-FOLD is non-nil.
|
||||
This function added by MH-E for Emacs versions that lack
|
||||
`assoc-string', introduced in Emacs 22."
|
||||
(if case-fold
|
||||
(assoc-ignore-case key list)
|
||||
(assoc key list)))
|
||||
|
||||
(require 'mailabbrev nil t)
|
||||
(mh-defun-compat mh-mail-abbrev-make-syntax-table
|
||||
mail-abbrev-make-syntax-table ()
|
||||
"Emacs 21 and XEmacs don't have this function."
|
||||
nil)
|
||||
|
||||
(defmacro mh-display-completion-list (completions &optional common-substring)
|
||||
"Display the list of COMPLETIONS.
|
||||
See documentation for `display-completion-list' for a description of the
|
||||
arguments COMPLETIONS and perhaps COMMON-SUBSTRING.
|
||||
This macro added by MH-E for Emacs versions that lack a
|
||||
COMMON-SUBSTRING argument, introduced in Emacs 22."
|
||||
(if (< emacs-major-version 22)
|
||||
`(display-completion-list ,completions)
|
||||
`(display-completion-list ,completions ,common-substring)))
|
||||
|
||||
(defmacro mh-face-foreground (face &optional frame inherit)
|
||||
"Return the foreground color name of FACE, or nil if unspecified.
|
||||
See documentation for `face-foreground' for a description of the
|
||||
arguments FACE, FRAME, and perhaps INHERIT.
|
||||
This macro added by MH-E for Emacs versions that lack an INHERIT
|
||||
argument, introduced in Emacs 22."
|
||||
(if (< emacs-major-version 22)
|
||||
`(face-foreground ,face ,frame)
|
||||
`(face-foreground ,face ,frame ,inherit)))
|
||||
|
||||
(defmacro mh-face-background (face &optional frame inherit)
|
||||
"Return the background color name of face, or nil if unspecified.
|
||||
See documentation for `back-foreground' for a description of the
|
||||
arguments FACE, FRAME, and INHERIT.
|
||||
This macro added by MH-E for Emacs versions that lack an INHERIT
|
||||
argument, introduced in Emacs 22."
|
||||
(if (< emacs-major-version 22)
|
||||
`(face-background ,face ,frame)
|
||||
`(face-background ,face ,frame ,inherit)))
|
||||
|
||||
;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21.
|
||||
(if (not (boundp 'url-unreserved-chars))
|
||||
(defconst mh-url-unresrved-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."))
|
||||
|
||||
(mh-defun-compat mh-url-hexify-string url-hexify-string (str)
|
||||
"Escape characters in a string.
|
||||
This is a copy of `url-hexify-string' from url-util.el in Emacs
|
||||
22; needed by Emacs 21."
|
||||
(mapconcat
|
||||
(lambda (char)
|
||||
;; Fixme: use a char table instead.
|
||||
(if (not (memq char mh-url-unreserved-chars))
|
||||
(if (> char 255)
|
||||
(error "Hexifying multibyte character %s" str)
|
||||
(format "%%%02X" char))
|
||||
(char-to-string char)))
|
||||
str ""))
|
||||
|
||||
(defmacro mh-write-file-functions ()
|
||||
"Return `write-file-functions' if it exists.
|
||||
Otherwise return `local-write-file-hooks'.
|
||||
This macro exists purely for compatibility. The former symbol is used
|
||||
in Emacs 22 onward while the latter is used in previous versions and
|
||||
XEmacs."
|
||||
(if (boundp 'write-file-functions)
|
||||
''write-file-functions ;Emacs 22 on
|
||||
''local-write-file-hooks)) ;XEmacs
|
||||
|
||||
(provide 'mh-compat)
|
||||
|
||||
;; Local Variables:
|
||||
;; no-byte-compile: t
|
||||
;; indent-tabs-mode: nil
|
||||
;; sentence-end-double-space: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 577b0eab-a5cd-45e1-8d9f-c1a426f4d73c
|
||||
;;; mh-compat.el ends here
|
||||
File diff suppressed because it is too large
Load diff
5677
lisp/mh-e/mh-e.el
5677
lisp/mh-e/mh-e.el
File diff suppressed because it is too large
Load diff
|
|
@ -1,264 +0,0 @@
|
|||
;;; mh-exec.el --- MH-E process support
|
||||
|
||||
;; Copyright (C) 1993, 1995, 1997,
|
||||
;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Bill Wohler <wohler@newt.com>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Issue shell and MH commands
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
(mh-require-cl)
|
||||
|
||||
(require 'mh-buffers)
|
||||
(require 'mh-utils)
|
||||
|
||||
(defvar mh-progs nil
|
||||
"Directory containing MH commands, such as inc, repl, and rmm.")
|
||||
|
||||
;;;###autoload
|
||||
(put 'mh-progs 'risky-local-variable t)
|
||||
|
||||
(defvar mh-lib nil
|
||||
"Directory containing the MH library.
|
||||
This directory contains, among other things, the components file.")
|
||||
|
||||
;;;###autoload
|
||||
(put 'mh-lib 'risky-local-variable t)
|
||||
|
||||
(defvar mh-lib-progs nil
|
||||
"Directory containing MH helper programs.
|
||||
This directory contains, among other things, the mhl program.")
|
||||
|
||||
;;;###autoload
|
||||
(put 'mh-lib-progs 'risky-local-variable t)
|
||||
|
||||
(defvar mh-index-max-cmdline-args 500
|
||||
"Maximum number of command line args.")
|
||||
|
||||
(defun mh-xargs (cmd &rest args)
|
||||
"Partial imitation of xargs.
|
||||
The current buffer contains a list of strings, one on each line.
|
||||
The function will execute CMD with ARGS and pass the first
|
||||
`mh-index-max-cmdline-args' strings to it. This is repeated till
|
||||
all the strings have been used."
|
||||
(goto-char (point-min))
|
||||
(let ((current-buffer (current-buffer)))
|
||||
(with-temp-buffer
|
||||
(let ((out (current-buffer)))
|
||||
(set-buffer current-buffer)
|
||||
(while (not (eobp))
|
||||
(let ((arg-list (reverse args))
|
||||
(count 0))
|
||||
(while (and (not (eobp)) (< count mh-index-max-cmdline-args))
|
||||
(push (buffer-substring-no-properties (point) (line-end-position))
|
||||
arg-list)
|
||||
(incf count)
|
||||
(forward-line))
|
||||
(apply #'call-process cmd nil (list out nil) nil
|
||||
(nreverse arg-list))))
|
||||
(erase-buffer)
|
||||
(insert-buffer-substring out)))))
|
||||
|
||||
;; XXX This should be applied anywhere MH-E calls out to /bin/sh.
|
||||
(defun mh-quote-for-shell (string)
|
||||
"Quote STRING for /bin/sh.
|
||||
Adds double-quotes around entire string and quotes the characters
|
||||
\\, `, and $ with a backslash."
|
||||
(concat "\""
|
||||
(loop for x across string
|
||||
concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x))
|
||||
"\""))
|
||||
|
||||
(defun mh-exec-cmd (command &rest args)
|
||||
"Execute mh-command COMMAND with ARGS.
|
||||
The side effects are what is desired. Any output is assumed to be
|
||||
an error and is shown to the user. The output is not read or
|
||||
parsed by MH-E."
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-log-buffer))
|
||||
(let* ((initial-size (mh-truncate-log-buffer))
|
||||
(start (point))
|
||||
(args (mh-list-to-string args)))
|
||||
(apply 'call-process (expand-file-name command mh-progs) nil t nil args)
|
||||
(when (> (buffer-size) initial-size)
|
||||
(save-excursion
|
||||
(goto-char start)
|
||||
(insert "Errors when executing: " command)
|
||||
(loop for arg in args do (insert " " arg))
|
||||
(insert "\n"))
|
||||
(save-window-excursion
|
||||
(switch-to-buffer-other-window mh-log-buffer)
|
||||
(sit-for 5))))))
|
||||
|
||||
(defun mh-exec-cmd-error (env command &rest args)
|
||||
"In environment ENV, execute mh-command COMMAND with ARGS.
|
||||
ENV is nil or a string of space-separated \"var=value\" elements.
|
||||
Signals an error if process does not complete successfully."
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(erase-buffer)
|
||||
(let ((process-environment process-environment))
|
||||
;; XXX: We should purge the list that split-string returns of empty
|
||||
;; strings. This can happen in XEmacs if leading or trailing spaces
|
||||
;; are present.
|
||||
(dolist (elem (if (stringp env) (split-string env " ") ()))
|
||||
(push elem process-environment))
|
||||
(mh-handle-process-error
|
||||
command (apply #'call-process (expand-file-name command mh-progs)
|
||||
nil t nil (mh-list-to-string args))))))
|
||||
|
||||
(defun mh-exec-cmd-daemon (command filter &rest args)
|
||||
"Execute MH command COMMAND in the background.
|
||||
|
||||
If FILTER is non-nil then it is used to process the output
|
||||
otherwise the default filter `mh-process-daemon' is used. See
|
||||
`set-process-filter' for more details of FILTER.
|
||||
|
||||
ARGS are passed to COMMAND as command line arguments."
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-log-buffer))
|
||||
(mh-truncate-log-buffer))
|
||||
(let* ((process-connection-type nil)
|
||||
(process (apply 'start-process
|
||||
command nil
|
||||
(expand-file-name command mh-progs)
|
||||
(mh-list-to-string args))))
|
||||
(set-process-filter process (or filter 'mh-process-daemon))
|
||||
process))
|
||||
|
||||
(defun mh-exec-cmd-env-daemon (env command filter &rest args)
|
||||
"In ennvironment ENV, execute mh-command COMMAND in the background.
|
||||
|
||||
ENV is nil or a string of space-separated \"var=value\" elements.
|
||||
Signals an error if process does not complete successfully.
|
||||
|
||||
If FILTER is non-nil then it is used to process the output
|
||||
otherwise the default filter `mh-process-daemon' is used. See
|
||||
`set-process-filter' for more details of FILTER.
|
||||
|
||||
ARGS are passed to COMMAND as command line arguments."
|
||||
(let ((process-environment process-environment))
|
||||
(dolist (elem (if (stringp env) (split-string env " ") ()))
|
||||
(push elem process-environment))
|
||||
(apply #'mh-exec-cmd-daemon command filter args)))
|
||||
|
||||
(defun mh-process-daemon (process output)
|
||||
"PROCESS daemon that puts OUTPUT into a temporary buffer.
|
||||
Any output from the process is displayed in an asynchronous
|
||||
pop-up window."
|
||||
(with-current-buffer (get-buffer-create mh-log-buffer)
|
||||
(insert-before-markers output)
|
||||
(display-buffer mh-log-buffer)))
|
||||
|
||||
(defun mh-exec-cmd-quiet (raise-error command &rest args)
|
||||
"Signal RAISE-ERROR if COMMAND with ARGS fails.
|
||||
Execute MH command COMMAND with ARGS. ARGS is a list of strings.
|
||||
Return at start of mh-temp buffer, where output can be parsed and
|
||||
used.
|
||||
Returns value of `call-process', which is 0 for success, unless
|
||||
RAISE-ERROR is non-nil, in which case an error is signaled if
|
||||
`call-process' returns non-0."
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(erase-buffer)
|
||||
(let ((value
|
||||
(apply 'call-process
|
||||
(expand-file-name command mh-progs) nil t nil
|
||||
args)))
|
||||
(goto-char (point-min))
|
||||
(if raise-error
|
||||
(mh-handle-process-error command value)
|
||||
value)))
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile (defvar mark-active))
|
||||
|
||||
(defun mh-exec-cmd-output (command display &rest args)
|
||||
"Execute MH command COMMAND with DISPLAY flag and ARGS.
|
||||
Put the output into buffer after point.
|
||||
Set mark after inserted text.
|
||||
Output is expected to be shown to user, not parsed by MH-E."
|
||||
(push-mark (point) t)
|
||||
(apply 'call-process
|
||||
(expand-file-name command mh-progs) nil t display
|
||||
(mh-list-to-string args))
|
||||
|
||||
;; The following is used instead of 'exchange-point-and-mark because the
|
||||
;; latter activates the current region (between point and mark), which
|
||||
;; turns on highlighting. So prior to this bug fix, doing "inc" would
|
||||
;; highlight a region containing the new messages, which is undesirable.
|
||||
;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4.
|
||||
(mh-exchange-point-and-mark-preserving-active-mark))
|
||||
|
||||
(defun mh-exchange-point-and-mark-preserving-active-mark ()
|
||||
"Put the mark where point is now, and point where the mark is now.
|
||||
This command works even when the mark is not active, and
|
||||
preserves whether the mark is active or not."
|
||||
(interactive nil)
|
||||
(let ((is-active (and (boundp 'mark-active) mark-active)))
|
||||
(let ((omark (mark t)))
|
||||
(if (null omark)
|
||||
(error "No mark set in this buffer"))
|
||||
(set-mark (point))
|
||||
(goto-char omark)
|
||||
(if (boundp 'mark-active)
|
||||
(setq mark-active is-active))
|
||||
nil)))
|
||||
|
||||
(defun mh-exec-lib-cmd-output (command &rest args)
|
||||
"Execute MH library command COMMAND with ARGS.
|
||||
Put the output into buffer after point.
|
||||
Set mark after inserted text."
|
||||
(apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil args))
|
||||
|
||||
(defun mh-handle-process-error (command status)
|
||||
"Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS."
|
||||
(if (equal status 0)
|
||||
status
|
||||
(goto-char (point-min))
|
||||
(insert (if (integerp status)
|
||||
(format "%s: exit code %d\n" command status)
|
||||
(format "%s: %s\n" command status)))
|
||||
(save-excursion
|
||||
(let ((error-message (buffer-substring (point-min) (point-max))))
|
||||
(set-buffer (get-buffer-create mh-log-buffer))
|
||||
(mh-truncate-log-buffer)
|
||||
(insert error-message)))
|
||||
(error "%s failed, check buffer %s for error message"
|
||||
command mh-log-buffer)))
|
||||
|
||||
(provide 'mh-exec)
|
||||
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; sentence-end-double-space: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 2857996c-e624-46b2-a58d-979cd279d288
|
||||
;;; mh-utils.el ends here
|
||||
1979
lisp/mh-e/mh-folder.el
Normal file
1979
lisp/mh-e/mh-folder.el
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -27,34 +27,19 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; Internal support for MH-E package.
|
||||
;; Putting these functions in a separate file lets MH-E start up faster,
|
||||
;; since less Lisp code needs to be loaded all at once.
|
||||
|
||||
;; Please add the functions in alphabetical order. If only one or two
|
||||
;; small support routines are needed, place them with the function;
|
||||
;; otherwise, create a separate section for them.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;(message "> mh-funcs")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
(mh-require-cl)
|
||||
(require 'mh-buffers)
|
||||
(require 'mh-e)
|
||||
;;(message "< mh-funcs")
|
||||
|
||||
|
||||
|
||||
;;; Scan Line Formats
|
||||
|
||||
(defvar mh-note-copied "C"
|
||||
"Messages that have been copied are marked by this character.")
|
||||
|
||||
(defvar mh-note-printed "P"
|
||||
"Messages that have been printed are marked by this character.")
|
||||
|
||||
|
||||
|
||||
;;; Functions
|
||||
(require 'mh-scan)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-burst-digest ()
|
||||
|
|
@ -212,27 +197,6 @@ Display RANGE after packing, or the entire folder if RANGE is nil."
|
|||
(mh-reset-threads-and-narrowing)
|
||||
(mh-regenerate-headers range))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-pipe-msg (command include-header)
|
||||
"Pipe message through shell command COMMAND.
|
||||
|
||||
You are prompted for the Unix command through which you wish to
|
||||
run your message. If you give a prefix argument INCLUDE-HEADER to
|
||||
this command, the message header is included in the text passed
|
||||
to the command."
|
||||
(interactive
|
||||
(list (read-string "Shell command on message: ") current-prefix-arg))
|
||||
(let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
|
||||
(message-directory default-directory))
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(erase-buffer)
|
||||
(insert-file-contents msg-file-to-pipe)
|
||||
(goto-char (point-min))
|
||||
(if (not include-header) (search-forward "\n\n"))
|
||||
(let ((default-directory message-directory))
|
||||
(shell-command-on-region (point) (point-max) command nil)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-page-digest ()
|
||||
"Display next message in digest."
|
||||
|
|
@ -267,6 +231,27 @@ to the command."
|
|||
(forward-line 2))
|
||||
(mh-recenter 0)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-pipe-msg (command include-header)
|
||||
"Pipe message through shell command COMMAND.
|
||||
|
||||
You are prompted for the Unix command through which you wish to
|
||||
run your message. If you give a prefix argument INCLUDE-HEADER to
|
||||
this command, the message header is included in the text passed
|
||||
to the command."
|
||||
(interactive
|
||||
(list (read-string "Shell command on message: ") current-prefix-arg))
|
||||
(let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
|
||||
(message-directory default-directory))
|
||||
(save-excursion
|
||||
(set-buffer (get-buffer-create mh-temp-buffer))
|
||||
(erase-buffer)
|
||||
(insert-file-contents msg-file-to-pipe)
|
||||
(goto-char (point-min))
|
||||
(if (not include-header) (search-forward "\n\n"))
|
||||
(let ((default-directory message-directory))
|
||||
(shell-command-on-region (point) (point-max) command nil)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-sort-folder (&optional extra-args)
|
||||
"Sort folder.
|
||||
|
|
@ -288,21 +273,6 @@ By default, messages are sorted by date. The option
|
|||
(cond (threaded-flag (mh-toggle-threads))
|
||||
(mh-index-data (mh-index-insert-folder-headers)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-undo-folder ()
|
||||
"Undo all refiles and deletes in the current folder."
|
||||
(interactive)
|
||||
(cond ((or mh-do-not-confirm-flag
|
||||
(yes-or-no-p "Undo all commands in folder? "))
|
||||
(setq mh-delete-list nil
|
||||
mh-refile-list nil
|
||||
mh-seq-list nil
|
||||
mh-next-direction 'forward)
|
||||
(with-mh-folder-updating (nil)
|
||||
(mh-remove-all-notation)))
|
||||
(t
|
||||
(message "Commands not undone"))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-store-msg (directory)
|
||||
"Unpack message created with \"uudecode\" or \"shar\".
|
||||
|
|
@ -326,7 +296,6 @@ storing the content of these messages."
|
|||
(insert-file-contents msg-file-to-store)
|
||||
(mh-store-buffer directory))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-store-buffer (directory)
|
||||
"Unpack buffer created with \"uudecode\" or \"shar\".
|
||||
|
||||
|
|
@ -383,48 +352,20 @@ See `mh-store-msg' for a description of DIRECTORY."
|
|||
(insert "\n(mh-store finished)\n"))
|
||||
(error "Error occurred during execution of %s" command)))))
|
||||
|
||||
|
||||
|
||||
;;; Help Functions
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-ephem-message (string)
|
||||
"Display STRING in the minibuffer momentarily."
|
||||
(message "%s" string)
|
||||
(sit-for 5)
|
||||
(message ""))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-help ()
|
||||
"Display cheat sheet for the MH-E commands."
|
||||
(defun mh-undo-folder ()
|
||||
"Undo all refiles and deletes in the current folder."
|
||||
(interactive)
|
||||
(with-electric-help
|
||||
(function
|
||||
(lambda ()
|
||||
(insert
|
||||
(substitute-command-keys
|
||||
(mapconcat 'identity (cdr (assoc nil mh-help-messages)) ""))))
|
||||
mh-help-buffer)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-prefix-help ()
|
||||
"Display cheat sheet for the commands of the current prefix in minibuffer."
|
||||
(interactive)
|
||||
;; We got here because the user pressed a "?", but he pressed a prefix key
|
||||
;; before that. Since the the key vector starts at index 0, the index of the
|
||||
;; last keystroke is length-1 and thus the second to last keystroke is at
|
||||
;; length-2. We use that information to obtain a suitable prefix character
|
||||
;; from the recent keys.
|
||||
(let* ((keys (recent-keys))
|
||||
(prefix-char (elt keys (- (length keys) 2))))
|
||||
(with-electric-help
|
||||
(function
|
||||
(lambda ()
|
||||
(insert
|
||||
(substitute-command-keys
|
||||
(mapconcat 'identity
|
||||
(cdr (assoc prefix-char mh-help-messages)) "")))))
|
||||
mh-help-buffer)))
|
||||
(cond ((or mh-do-not-confirm-flag
|
||||
(yes-or-no-p "Undo all commands in folder? "))
|
||||
(setq mh-delete-list nil
|
||||
mh-refile-list nil
|
||||
mh-seq-list nil
|
||||
mh-next-direction 'forward)
|
||||
(with-mh-folder-updating (nil)
|
||||
(mh-remove-all-notation)))
|
||||
(t
|
||||
(message "Commands not undone"))))
|
||||
|
||||
(provide 'mh-funcs)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus.
|
||||
;;; mh-gnus.el --- make MH-E compatible with various versions of Gnus
|
||||
|
||||
;; Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -30,72 +30,70 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
;;(message "> mh-gnus")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
;;(message "< mh-gnus")
|
||||
(require 'mh-e)
|
||||
|
||||
;; Load libraries in a non-fatal way in order to see if certain functions are
|
||||
;; pre-defined.
|
||||
(load "mailabbrev" t t)
|
||||
(load "mailcap" t t)
|
||||
(load "mm-decode" t t)
|
||||
(load "mm-uu" t t)
|
||||
(load "mml" t t)
|
||||
(load "smiley" t t)
|
||||
(require 'gnus-util nil t)
|
||||
(require 'mm-bodies nil t)
|
||||
(require 'mm-decode nil t)
|
||||
(require 'mm-view nil t)
|
||||
(require 'mml nil t)
|
||||
|
||||
;; Copy of function from gnus-util.el.
|
||||
(mh-defun-compat gnus-local-map-property (map)
|
||||
(mh-defun-compat mh-gnus-local-map-property gnus-local-map-property (map)
|
||||
"Return a list suitable for a text property list specifying keymap MAP."
|
||||
(cond (mh-xemacs-flag (list 'keymap map))
|
||||
((>= emacs-major-version 21) (list 'keymap map))
|
||||
(t (list 'local-map map))))
|
||||
|
||||
;; Copy of function from mm-decode.el.
|
||||
(mh-defun-compat mm-merge-handles (handles1 handles2)
|
||||
(mh-defun-compat mh-mm-merge-handles mm-merge-handles (handles1 handles2)
|
||||
(append (if (listp (car handles1)) handles1 (list handles1))
|
||||
(if (listp (car handles2)) handles2 (list handles2))))
|
||||
|
||||
;; Copy of function from mm-decode.el.
|
||||
(mh-defun-compat mm-set-handle-multipart-parameter (handle parameter value)
|
||||
(mh-defun-compat mh-mm-set-handle-multipart-parameter
|
||||
mm-set-handle-multipart-parameter (handle parameter value)
|
||||
;; HANDLE could be a CTL.
|
||||
(if handle
|
||||
(put-text-property 0 (length (car handle)) parameter value
|
||||
(car handle))))
|
||||
|
||||
;; Copy of function from mm-view.el.
|
||||
(mh-defun-compat mm-inline-text-vcard (handle)
|
||||
(mh-defun-compat mh-mm-inline-text-vcard 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))))))))
|
||||
(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))))))))
|
||||
|
||||
;; Function from mm-decode.el used in PGP messages. Just define it with older
|
||||
;; Gnus to avoid compiler warning.
|
||||
(mh-defun-compat mm-possibly-verify-or-decrypt (parts ctl)
|
||||
(mh-defun-compat mh-mm-possibly-verify-or-decrypt
|
||||
mm-possibly-verify-or-decrypt (parts ctl)
|
||||
nil)
|
||||
|
||||
;; Copy of macro in mm-decode.el.
|
||||
(mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter)
|
||||
(mh-defmacro-compat mh-mm-handle-multipart-ctl-parameter
|
||||
mm-handle-multipart-ctl-parameter (handle parameter)
|
||||
`(get-text-property 0 ,parameter (car ,handle)))
|
||||
|
||||
;; Copy of function in mm-decode.el.
|
||||
(mh-defun-compat mm-readable-p (handle)
|
||||
(mh-defun-compat mh-mm-readable-p 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))))))
|
||||
(not (mh-mm-long-lines-p 76))))))
|
||||
|
||||
;; Copy of function in mm-bodies.el.
|
||||
(mh-defun-compat mm-long-lines-p (length)
|
||||
(mh-defun-compat mh-mm-long-lines-p mm-long-lines-p (length)
|
||||
"Say whether any of the lines in the buffer is longer than LENGTH."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
|
|
@ -107,17 +105,22 @@
|
|||
(and (> (current-column) length)
|
||||
(current-column))))
|
||||
|
||||
(mh-defun-compat mm-keep-viewer-alive-p (handle)
|
||||
(mh-defun-compat mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle)
|
||||
;; Released Gnus doesn't keep handles associated with externally displayed
|
||||
;; MIME parts. So this will always return nil.
|
||||
nil)
|
||||
|
||||
(mh-defun-compat mm-destroy-parts (list)
|
||||
(mh-defun-compat mh-mm-destroy-parts mm-destroy-parts (list)
|
||||
"Older versions of Emacs don't have this function."
|
||||
nil)
|
||||
|
||||
(mh-defun-compat mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles)
|
||||
"Emacs 21 and XEmacs don't have this function."
|
||||
nil)
|
||||
|
||||
;; Copy of function in mml.el.
|
||||
(mh-defun-compat mml-minibuffer-read-disposition (type &optional default)
|
||||
(mh-defun-compat mh-mml-minibuffer-read-disposition
|
||||
mml-minibuffer-read-disposition (type &optional default)
|
||||
(unless default (setq default
|
||||
(if (and (string-match "\\`text/" type)
|
||||
(not (string-match "\\`text/rtf\\'" type)))
|
||||
|
|
@ -128,7 +131,7 @@
|
|||
'(("attachment") ("inline") (""))
|
||||
nil t nil nil default)))
|
||||
(if (not (equal disposition ""))
|
||||
disposition
|
||||
disposition
|
||||
default)))
|
||||
|
||||
;; This is mm-save-part from Gnus 5.10 since that function in emacs21.2 is
|
||||
|
|
@ -158,11 +161,6 @@
|
|||
(or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer)
|
||||
(and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))
|
||||
|
||||
(defun mh-mail-abbrev-make-syntax-table ()
|
||||
"Call `mail-abbrev-make-syntax-table' if available."
|
||||
(when (fboundp 'mail-abbrev-make-syntax-table)
|
||||
(mail-abbrev-make-syntax-table)))
|
||||
|
||||
(provide 'mh-gnus)
|
||||
|
||||
;; Local Variables:
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; mh-identity.el --- Multiple identify support for MH-E.
|
||||
;;; mh-identity.el --- multiple identify support for MH-E
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -27,23 +27,19 @@
|
|||
;;; Commentary:
|
||||
|
||||
;; Multiple identity support for MH-E.
|
||||
;;
|
||||
;; Used to easily set different fields such as From and Organization, as
|
||||
;; well as different signature files.
|
||||
;;
|
||||
;; Customize the variable `mh-identity-list' and an Identity menu will
|
||||
;; appear in mh-letter-mode. The command 'mh-insert-identity can be used
|
||||
;; from the command line.
|
||||
|
||||
;; Used to easily set different fields such as From and Organization,
|
||||
;; as well as different signature files.
|
||||
|
||||
;; Customize the variable `mh-identity-list' and see the Identity menu
|
||||
;; in MH-Letter mode. The command `mh-insert-identity' can be used
|
||||
;; to manually insert an identity.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;(message "> mh-identity")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
|
||||
(require 'mh-comp)
|
||||
;;(message "< mh-identity")
|
||||
(require 'mh-e)
|
||||
|
||||
(autoload 'mml-insert-tag "mml")
|
||||
|
||||
|
|
@ -53,11 +49,17 @@ This is normally set as part of an Identity in
|
|||
`mh-identity-list'.")
|
||||
(make-variable-buffer-local 'mh-identity-pgg-default-user-id)
|
||||
|
||||
(defvar mh-identity-menu nil
|
||||
"The Identity menu.")
|
||||
|
||||
(defalias 'mh-identity-make-menu-no-autoload 'mh-identity-make-menu)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-identity-make-menu ()
|
||||
"Build the Identity menu.
|
||||
This should be called any time `mh-identity-list' or
|
||||
`mh-auto-fields-list' change."
|
||||
`mh-auto-fields-list' change.
|
||||
See `mh-identity-add-menu'."
|
||||
(easy-menu-define mh-identity-menu mh-letter-mode-map
|
||||
"MH-E identity menu"
|
||||
(append
|
||||
|
|
@ -88,13 +90,11 @@ This should be called any time `mh-identity-list' or
|
|||
))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-identity-list-set (symbol value)
|
||||
"Update the `mh-identity-list' variable, and rebuild the menu.
|
||||
Sets the default for SYMBOL (for example, `mh-identity-list') to
|
||||
VALUE (as set in customization). This is called after 'customize
|
||||
is used to alter `mh-identity-list'."
|
||||
(set-default symbol value)
|
||||
(mh-identity-make-menu))
|
||||
(defun mh-identity-add-menu ()
|
||||
"Add the current Identity menu.
|
||||
See `mh-identity-make-menu'."
|
||||
(if mh-identity-menu
|
||||
(easy-menu-add mh-identity-menu)))
|
||||
|
||||
(defvar mh-identity-local nil
|
||||
"Buffer-local variable that holds the identity currently in use.")
|
||||
|
|
@ -127,15 +127,20 @@ The field name is downcased. If the FIELD begins with the
|
|||
character \":\", then it must have a special handler defined in
|
||||
`mh-identity-handlers', else return an error since it is not a
|
||||
valid header field."
|
||||
(or (cdr (assoc-string field mh-identity-handlers t))
|
||||
(or (cdr (mh-assoc-string field mh-identity-handlers t))
|
||||
(and (eq (aref field 0) ?:)
|
||||
(error "Field %s not found in `mh-identity-handlers'" field))
|
||||
(cdr (assoc ":default" mh-identity-handlers))
|
||||
'mh-identity-handler-default))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-insert-identity (identity)
|
||||
(defun mh-insert-identity (identity &optional maybe-insert)
|
||||
"Insert fields specified by given IDENTITY.
|
||||
|
||||
In a program, do not insert fields if MAYBE-INSERT is non-nil,
|
||||
`mh-identity-default' is non-nil, and fields have already been
|
||||
inserted.
|
||||
|
||||
See `mh-identity-list'."
|
||||
(interactive
|
||||
(list (completing-read
|
||||
|
|
@ -144,29 +149,35 @@ See `mh-identity-list'."
|
|||
(cons '("None")
|
||||
(mapcar 'list (mapcar 'car mh-identity-list)))
|
||||
(mapcar 'list (mapcar 'car mh-identity-list)))
|
||||
nil t)))
|
||||
(save-excursion
|
||||
;;First remove old settings, if any.
|
||||
(when mh-identity-local
|
||||
(let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
|
||||
(while pers-list
|
||||
(let* ((field (caar pers-list))
|
||||
(handler (mh-identity-field-handler field)))
|
||||
(funcall handler field 'remove))
|
||||
(setq pers-list (cdr pers-list)))))
|
||||
;; Then insert the replacement
|
||||
(when (not (equal "None" identity))
|
||||
(let ((pers-list (cadr (assoc identity mh-identity-list))))
|
||||
(while pers-list
|
||||
(let* ((field (caar pers-list))
|
||||
(value (cdar pers-list))
|
||||
(handler (mh-identity-field-handler field)))
|
||||
(funcall handler field 'add value))
|
||||
(setq pers-list (cdr pers-list))))))
|
||||
;; Remember what is in use in this buffer
|
||||
(if (equal "None" identity)
|
||||
(setq mh-identity-local nil)
|
||||
(setq mh-identity-local identity)))
|
||||
nil t)
|
||||
nil))
|
||||
|
||||
(when (or (not maybe-insert)
|
||||
(and (boundp 'mh-identity-default)
|
||||
mh-identity-default
|
||||
(not mh-identity-local)))
|
||||
(save-excursion
|
||||
;;First remove old settings, if any.
|
||||
(when mh-identity-local
|
||||
(let ((pers-list (cadr (assoc mh-identity-local mh-identity-list))))
|
||||
(while pers-list
|
||||
(let* ((field (caar pers-list))
|
||||
(handler (mh-identity-field-handler field)))
|
||||
(funcall handler field 'remove))
|
||||
(setq pers-list (cdr pers-list)))))
|
||||
;; Then insert the replacement
|
||||
(when (not (equal "None" identity))
|
||||
(let ((pers-list (cadr (assoc identity mh-identity-list))))
|
||||
(while pers-list
|
||||
(let* ((field (caar pers-list))
|
||||
(value (cdar pers-list))
|
||||
(handler (mh-identity-field-handler field)))
|
||||
(funcall handler field 'add value))
|
||||
(setq pers-list (cdr pers-list))))))
|
||||
;; Remember what is in use in this buffer
|
||||
(if (equal "None" identity)
|
||||
(setq mh-identity-local nil)
|
||||
(setq mh-identity-local identity))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-identity-handler-gpg-identity (field action &optional value)
|
||||
|
|
@ -268,7 +279,7 @@ bottom of the header. If action is 'add, the VALUE is added."
|
|||
(t
|
||||
(goto-char (point-min))
|
||||
(if (not top)
|
||||
(mh-goto-header-end 0))
|
||||
(mh-goto-header-end 0))
|
||||
(insert field-colon " " value "\n")))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; mh-inc.el --- MH-E "inc" and separate mail spool handling
|
||||
;;
|
||||
|
||||
;; Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Peter S. Galbraith <psg@debian.org>
|
||||
|
|
@ -26,33 +26,42 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; Support for inc. In addition to reading from the system mailbox, inc can
|
||||
;; also be used to incorporate mail from multiple spool files into separate
|
||||
;; folders. See "C-h v mh-inc-spool-list".
|
||||
;; Support for inc. In addition to reading from the system mailbox,
|
||||
;; inc can also be used to incorporate mail from multiple spool files
|
||||
;; into separate folders. See "C-h v mh-inc-spool-list".
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;(message "> mh-inc")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
(require 'mh-e)
|
||||
(mh-require-cl)
|
||||
;;(message "< mh-inc")
|
||||
|
||||
(defvar mh-inc-spool-map (make-sparse-keymap)
|
||||
"Keymap for MH-E's mh-inc-spool commands.")
|
||||
|
||||
(defvar mh-inc-spool-map-help nil
|
||||
"Help text to for `mh-inc-spool-map'.")
|
||||
"Help text for `mh-inc-spool-map'.")
|
||||
|
||||
(define-key mh-inc-spool-map "?"
|
||||
'(lambda ()
|
||||
(interactive)
|
||||
(if mh-inc-spool-map-help
|
||||
(let ((mh-help-messages (list (list nil mh-inc-spool-map-help))))
|
||||
(mh-help))
|
||||
(mh-help mh-inc-spool-map-help)
|
||||
(mh-ephem-message
|
||||
"There are no keys defined yet. Customize `mh-inc-spool-list'"))))
|
||||
"There are no keys defined yet; customize `mh-inc-spool-list'"))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-inc-spool-make ()
|
||||
"Make all commands and defines keys for contents of `mh-inc-spool-list'."
|
||||
(setq mh-inc-spool-map-help nil)
|
||||
(when mh-inc-spool-list
|
||||
(loop for elem in mh-inc-spool-list
|
||||
do (let ((spool (nth 0 elem))
|
||||
(folder (nth 1 elem))
|
||||
(key (nth 2 elem)))
|
||||
(progn
|
||||
(mh-inc-spool-generator folder spool)
|
||||
(mh-inc-spool-def-key key folder))))))
|
||||
|
||||
(defalias 'mh-inc-spool-make-no-autoload 'mh-inc-spool-make)
|
||||
|
||||
(defun mh-inc-spool-generator (folder spool)
|
||||
"Create a command to inc into FOLDER from SPOOL file."
|
||||
|
|
@ -62,7 +71,7 @@
|
|||
(set spool1 spool)
|
||||
(setf (symbol-function (intern (concat "mh-inc-spool-" folder)))
|
||||
`(lambda ()
|
||||
,(format "Inc spool file %s into folder %s" spool folder)
|
||||
,(format "Inc spool file %s into folder %s." spool folder)
|
||||
(interactive)
|
||||
(mh-inc-folder ,spool1 (concat "+" ,folder1))))))
|
||||
|
||||
|
|
@ -71,32 +80,9 @@
|
|||
(when (not (= 0 key))
|
||||
(define-key mh-inc-spool-map (format "%c" key)
|
||||
(intern (concat "mh-inc-spool-" folder)))
|
||||
(setq mh-inc-spool-map-help (concat mh-inc-spool-map-help "["
|
||||
(char-to-string key)
|
||||
"] inc " folder " folder\n"))))
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile (defvar mh-inc-spool-list))
|
||||
|
||||
(defun mh-inc-spool-make ()
|
||||
"Make all commands and defines keys for contents of `mh-inc-spool-list'."
|
||||
(when mh-inc-spool-list
|
||||
(setq mh-inc-spool-map-help nil)
|
||||
(loop for elem in mh-inc-spool-list
|
||||
do (let ((spool (nth 0 elem))
|
||||
(folder (nth 1 elem))
|
||||
(key (nth 2 elem)))
|
||||
(progn
|
||||
(mh-inc-spool-generator folder spool)
|
||||
(mh-inc-spool-def-key key folder))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-inc-spool-list-set (symbol value)
|
||||
"Set-default SYMBOL to VALUE to update the `mh-inc-spool-list' variable.
|
||||
Also rebuilds the user commands.
|
||||
This is called after 'customize is used to alter `mh-inc-spool-list'."
|
||||
(set-default symbol value)
|
||||
(mh-inc-spool-make))
|
||||
(add-to-list 'mh-inc-spool-map-help
|
||||
(concat "[" (char-to-string key) "] inc " folder " folder\n")
|
||||
t)))
|
||||
|
||||
(provide 'mh-inc)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,441 +0,0 @@
|
|||
;;; mh-init.el --- MH-E initialization
|
||||
|
||||
;; Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Peter S. Galbraith <psg@debian.org>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Sets up the MH variant (currently nmh, MH, or GNU mailutils).
|
||||
;;
|
||||
;; Users may customize `mh-variant' to switch between available variants.
|
||||
;; Available MH variants are returned by the function `mh-variants'.
|
||||
;; Developers may check which variant is currently in use with the
|
||||
;; variable `mh-variant-in-use' or the function `mh-variant-p'.
|
||||
;;
|
||||
;; Also contains code that is used at load or initialization time only.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;(message "> mh-init")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
(mh-require-cl)
|
||||
(require 'mh-buffers)
|
||||
(require 'mh-exec)
|
||||
;;(message "< mh-init")
|
||||
|
||||
(defvar mh-sys-path
|
||||
'("/usr/local/nmh/bin" ; nmh default
|
||||
"/usr/local/bin/mh/"
|
||||
"/usr/local/mh/"
|
||||
"/usr/bin/mh/" ; Ultrix 4.2, Linux
|
||||
"/usr/new/mh/" ; Ultrix < 4.2
|
||||
"/usr/contrib/mh/bin/" ; BSDI
|
||||
"/usr/pkg/bin/" ; NetBSD
|
||||
"/usr/local/bin/"
|
||||
"/usr/local/bin/mu-mh/" ; GNU mailutils - default
|
||||
"/usr/bin/mu-mh/") ; GNU mailutils - packaged
|
||||
"List of directories to search for variants of the MH variant.
|
||||
The list `exec-path' is searched in addition to this list.
|
||||
There's no need for users to modify this list. Instead add extra
|
||||
directories to the customizable variable `mh-path'.")
|
||||
|
||||
;; Set for local environment:
|
||||
;; mh-progs and mh-lib used to be set in paths.el, which tried to
|
||||
;; figure out at build time which of several possible directories MH
|
||||
;; was installed into. But if you installed MH after building Emacs,
|
||||
;; this would almost certainly be wrong, so now we do it at run time.
|
||||
|
||||
(defvar mh-flists-present-flag nil
|
||||
"Non-nil means that we have \"flists\".")
|
||||
|
||||
(defvar mh-variants nil
|
||||
"List describing known MH variants.
|
||||
Do not access this variable directly as it may not have yet been initialized.
|
||||
Use the function `mh-variants' instead.")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-variants ()
|
||||
"Return a list of installed variants of MH on the system.
|
||||
This function looks for MH in `mh-sys-path', `mh-path' and
|
||||
`exec-path'. The format of the list of variants that is returned
|
||||
is described by the variable `mh-variants'."
|
||||
(if mh-variants
|
||||
mh-variants
|
||||
(let ((list-unique))
|
||||
;; Make a unique list of directories, keeping the given order.
|
||||
;; We don't want the same MH variant to be listed multiple times.
|
||||
(loop for dir in (append mh-path mh-sys-path exec-path) do
|
||||
(setq dir (file-chase-links (directory-file-name dir)))
|
||||
(add-to-list 'list-unique dir))
|
||||
(loop for dir in (nreverse list-unique) do
|
||||
(when (and dir (file-directory-p dir) (file-readable-p dir))
|
||||
(let ((variant (mh-variant-info dir)))
|
||||
(if variant
|
||||
(add-to-list 'mh-variants variant)))))
|
||||
mh-variants)))
|
||||
|
||||
(defun mh-variant-info (dir)
|
||||
"Return MH variant found in DIR, or nil if none present."
|
||||
(save-excursion
|
||||
(let ((tmp-buffer (get-buffer-create mh-temp-buffer)))
|
||||
(set-buffer tmp-buffer)
|
||||
(cond
|
||||
((mh-variant-mh-info dir))
|
||||
((mh-variant-nmh-info dir))
|
||||
((mh-variant-mu-mh-info dir))))))
|
||||
|
||||
(defun mh-variant-mh-info (dir)
|
||||
"Return info for MH variant in DIR assuming a temporary buffer is setup."
|
||||
;; MH does not have the -version option.
|
||||
;; Its version number is included in the output of "-help" as:
|
||||
;;
|
||||
;; version: MH 6.8.4 #2[UCI] (burrito) of Fri Jan 15 20:01:39 EST 1999
|
||||
;; options: [ATHENA] [BIND] [DUMB] [LIBLOCKFILE] [LOCALE] [MAILGROUP] [MHE]
|
||||
;; [MHRC] [MIME] [MORE='"/usr/bin/sensible-pager"'] [NLINK_HACK]
|
||||
;; [NORUSERPASS] [OVERHEAD] [POP] [POPSERVICE='"pop-3"'] [RENAME]
|
||||
;; [RFC1342] [RPATHS] [RPOP] [SENDMTS] [SMTP] [SOCKETS]
|
||||
;; [SPRINTFTYPE=int] [SVR4] [SYS5] [SYS5DIR] [TERMINFO]
|
||||
;; [TYPESIG=void] [UNISTD] [UTK] [VSPRINTF]
|
||||
(let ((mhparam (expand-file-name "mhparam" dir)))
|
||||
(when (mh-file-command-p mhparam)
|
||||
(erase-buffer)
|
||||
(call-process mhparam nil '(t nil) nil "-help")
|
||||
(goto-char (point-min))
|
||||
(when (search-forward-regexp "version: MH \\(\\S +\\)" nil t)
|
||||
(let ((version (format "MH %s" (match-string 1))))
|
||||
(erase-buffer)
|
||||
(call-process mhparam nil '(t nil) nil "libdir")
|
||||
(goto-char (point-min))
|
||||
(when (search-forward-regexp "^.*$" nil t)
|
||||
(let ((libdir (match-string 0)))
|
||||
`(,version
|
||||
(variant mh)
|
||||
(mh-lib-progs ,libdir)
|
||||
(mh-lib ,libdir)
|
||||
(mh-progs ,dir)
|
||||
(flists nil)))))))))
|
||||
|
||||
(defun mh-variant-mu-mh-info (dir)
|
||||
"Return info for GNU mailutils variant in DIR.
|
||||
This assumes that a temporary buffer is setup."
|
||||
;; 'mhparam -version' output:
|
||||
;; mhparam (GNU mailutils 0.3.2)
|
||||
(let ((mhparam (expand-file-name "mhparam" dir)))
|
||||
(when (mh-file-command-p mhparam)
|
||||
(erase-buffer)
|
||||
(call-process mhparam nil '(t nil) nil "-version")
|
||||
(goto-char (point-min))
|
||||
(when (search-forward-regexp "mhparam (\\(GNU [Mm]ailutils \\S +\\))"
|
||||
nil t)
|
||||
(let ((version (match-string 1))
|
||||
(mh-progs dir))
|
||||
`(,version
|
||||
(variant mu-mh)
|
||||
(mh-lib-progs ,(mh-profile-component "libdir"))
|
||||
(mh-lib ,(mh-profile-component "etcdir"))
|
||||
(mh-progs ,dir)
|
||||
(flists ,(file-exists-p
|
||||
(expand-file-name "flists" dir)))))))))
|
||||
|
||||
(defun mh-variant-nmh-info (dir)
|
||||
"Return info for nmh variant in DIR assuming a temporary buffer is setup."
|
||||
;; `mhparam -version' outputs:
|
||||
;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003]
|
||||
(let ((mhparam (expand-file-name "mhparam" dir)))
|
||||
(when (mh-file-command-p mhparam)
|
||||
(erase-buffer)
|
||||
(call-process mhparam nil '(t nil) nil "-version")
|
||||
(goto-char (point-min))
|
||||
(when (search-forward-regexp "mhparam -- nmh-\\(\\S +\\)" nil t)
|
||||
(let ((version (format "nmh %s" (match-string 1)))
|
||||
(mh-progs dir))
|
||||
`(,version
|
||||
(variant nmh)
|
||||
(mh-lib-progs ,(mh-profile-component "libdir"))
|
||||
(mh-lib ,(mh-profile-component "etcdir"))
|
||||
(mh-progs ,dir)
|
||||
(flists ,(file-exists-p
|
||||
(expand-file-name "flists" dir)))))))))
|
||||
|
||||
(defun mh-file-command-p (file)
|
||||
"Return t if file FILE is the name of a executable regular file."
|
||||
(and (file-regular-p file) (file-executable-p file)))
|
||||
|
||||
(defvar mh-variant-in-use nil
|
||||
"The MH variant currently in use; a string with variant and version number.
|
||||
This differs from `mh-variant' when the latter is set to
|
||||
\"autodetect\".")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-variant-set (variant)
|
||||
"Set the MH variant to VARIANT.
|
||||
Sets `mh-progs', `mh-lib', `mh-lib-progs' and
|
||||
`mh-flists-present-flag'.
|
||||
If the VARIANT is \"autodetect\", then first try nmh, then MH and
|
||||
finally GNU mailutils."
|
||||
(interactive
|
||||
(list (completing-read
|
||||
"MH variant: "
|
||||
(mapcar (lambda (x) (list (car x))) (mh-variants))
|
||||
nil t)))
|
||||
(let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants))))
|
||||
(cond
|
||||
((eq variant 'none))
|
||||
((eq variant 'autodetect)
|
||||
(cond
|
||||
((mh-variant-set-variant 'nmh)
|
||||
(message "%s installed as MH variant" mh-variant-in-use))
|
||||
((mh-variant-set-variant 'mh)
|
||||
(message "%s installed as MH variant" mh-variant-in-use))
|
||||
((mh-variant-set-variant 'mu-mh)
|
||||
(message "%s installed as MH variant" mh-variant-in-use))
|
||||
(t
|
||||
(message "No MH variant found on the system"))))
|
||||
((member variant valid-list)
|
||||
(when (not (mh-variant-set-variant variant))
|
||||
(message "Warning: %s variant not found. Autodetecting..." variant)
|
||||
(mh-variant-set 'autodetect)))
|
||||
(t
|
||||
(message "Unknown variant; use %s"
|
||||
(mapconcat '(lambda (x) (format "%s" (car x)))
|
||||
(mh-variants) " or "))))))
|
||||
|
||||
(defun mh-variant-set-variant (variant)
|
||||
"Setup the system variables for the MH variant named VARIANT.
|
||||
If VARIANT is a string, use that key in the alist returned by the
|
||||
function `mh-variants'.
|
||||
If VARIANT is a symbol, select the first entry that matches that
|
||||
variant."
|
||||
(cond
|
||||
((stringp variant) ;e.g. "nmh 1.1-RC1"
|
||||
(when (assoc variant (mh-variants))
|
||||
(let* ((alist (cdr (assoc variant (mh-variants))))
|
||||
(lib-progs (cadr (assoc 'mh-lib-progs alist)))
|
||||
(lib (cadr (assoc 'mh-lib alist)))
|
||||
(progs (cadr (assoc 'mh-progs alist)))
|
||||
(flists (cadr (assoc 'flists alist))))
|
||||
;;(set-default mh-variant variant)
|
||||
(setq mh-x-mailer-string nil
|
||||
mh-flists-present-flag flists
|
||||
mh-lib-progs lib-progs
|
||||
mh-lib lib
|
||||
mh-progs progs
|
||||
mh-variant-in-use variant))))
|
||||
((symbolp variant) ;e.g. 'nmh (pick the first match)
|
||||
(loop for variant-list in (mh-variants)
|
||||
when (eq variant (cadr (assoc 'variant (cdr variant-list))))
|
||||
return (let* ((version (car variant-list))
|
||||
(alist (cdr variant-list))
|
||||
(lib-progs (cadr (assoc 'mh-lib-progs alist)))
|
||||
(lib (cadr (assoc 'mh-lib alist)))
|
||||
(progs (cadr (assoc 'mh-progs alist)))
|
||||
(flists (cadr (assoc 'flists alist))))
|
||||
;;(set-default mh-variant flavor)
|
||||
(setq mh-x-mailer-string nil
|
||||
mh-flists-present-flag flists
|
||||
mh-lib-progs lib-progs
|
||||
mh-lib lib
|
||||
mh-progs progs
|
||||
mh-variant-in-use version)
|
||||
t)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-variant-p (&rest variants)
|
||||
"Return t if variant is any of VARIANTS.
|
||||
Currently known variants are 'MH, 'nmh, and 'mu-mh."
|
||||
(let ((variant-in-use
|
||||
(cadr (assoc 'variant (assoc mh-variant-in-use (mh-variants))))))
|
||||
(not (null (member variant-in-use variants)))))
|
||||
|
||||
|
||||
|
||||
;;; Read MH Profile
|
||||
|
||||
(defvar mh-find-path-run nil
|
||||
"Non-nil if `mh-find-path' has been run already.
|
||||
Do not access this variable; `mh-find-path' already uses it to
|
||||
avoid running more than once.")
|
||||
|
||||
(defun mh-find-path ()
|
||||
"Set variables from user's MH profile.
|
||||
|
||||
This function sets `mh-user-path' from your \"Path:\" MH profile
|
||||
component (but defaults to \"Mail\" if one isn't present),
|
||||
`mh-draft-folder' from \"Draft-Folder:\", `mh-unseen-seq' from
|
||||
\"Unseen-Sequence:\", `mh-previous-seq' from
|
||||
\"Previous-Sequence:\", and `mh-inbox' from \"Inbox:\" (defaults
|
||||
to \"+inbox\").
|
||||
|
||||
The hook `mh-find-path-hook' is run after these variables have
|
||||
been set. This hook can be used the change the value of these
|
||||
variables if you need to run with different values between MH and
|
||||
MH-E."
|
||||
(unless mh-find-path-run
|
||||
;; Sanity checks.
|
||||
(if (and (getenv "MH")
|
||||
(not (file-readable-p (getenv "MH"))))
|
||||
(error "MH environment variable contains unreadable file %s"
|
||||
(getenv "MH")))
|
||||
(if (null (mh-variants))
|
||||
(error "Install MH and run install-mh before running MH-E"))
|
||||
(let ((profile "~/.mh_profile"))
|
||||
(if (not (file-readable-p profile))
|
||||
(error "Run install-mh before running MH-E")))
|
||||
;; Read MH profile.
|
||||
(setq mh-user-path (mh-profile-component "Path"))
|
||||
(if (not mh-user-path)
|
||||
(setq mh-user-path "Mail"))
|
||||
(setq mh-user-path
|
||||
(file-name-as-directory
|
||||
(expand-file-name mh-user-path (expand-file-name "~"))))
|
||||
(unless mh-x-image-cache-directory
|
||||
(setq mh-x-image-cache-directory
|
||||
(expand-file-name ".mhe-x-image-cache" mh-user-path)))
|
||||
(setq mh-draft-folder (mh-profile-component "Draft-Folder"))
|
||||
(if mh-draft-folder
|
||||
(progn
|
||||
(if (not (mh-folder-name-p mh-draft-folder))
|
||||
(setq mh-draft-folder (format "+%s" mh-draft-folder)))
|
||||
(if (not (file-exists-p (mh-expand-file-name mh-draft-folder)))
|
||||
(error
|
||||
"Draft folder \"%s\" not found; create it and try again"
|
||||
(mh-expand-file-name mh-draft-folder)))))
|
||||
(setq mh-inbox (mh-profile-component "Inbox"))
|
||||
(cond ((not mh-inbox)
|
||||
(setq mh-inbox "+inbox"))
|
||||
((not (mh-folder-name-p mh-inbox))
|
||||
(setq mh-inbox (format "+%s" mh-inbox))))
|
||||
(setq mh-unseen-seq (mh-profile-component "Unseen-Sequence"))
|
||||
(if mh-unseen-seq
|
||||
(setq mh-unseen-seq (intern mh-unseen-seq))
|
||||
(setq mh-unseen-seq 'unseen)) ;old MH default?
|
||||
(setq mh-previous-seq (mh-profile-component "Previous-Sequence"))
|
||||
(if mh-previous-seq
|
||||
(setq mh-previous-seq (intern mh-previous-seq)))
|
||||
(run-hooks 'mh-find-path-hook)
|
||||
(mh-collect-folder-names)
|
||||
(setq mh-find-path-run t)))
|
||||
|
||||
|
||||
|
||||
;;; MH profile
|
||||
|
||||
(defun mh-profile-component (component)
|
||||
"Return COMPONENT value from mhparam, or nil if unset."
|
||||
(save-excursion
|
||||
(mh-exec-cmd-quiet nil "mhparam" "-components" component)
|
||||
(mh-profile-component-value component)))
|
||||
|
||||
(defun mh-profile-component-value (component)
|
||||
"Find and return the value of COMPONENT in the current buffer.
|
||||
Returns nil if the component is not in the buffer."
|
||||
(let ((case-fold-search t))
|
||||
(goto-char (point-min))
|
||||
(cond ((not (re-search-forward (format "^%s:" component) nil t)) nil)
|
||||
((looking-at "[\t ]*$") nil)
|
||||
(t
|
||||
(re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
|
||||
(let ((start (match-beginning 1)))
|
||||
(end-of-line)
|
||||
(buffer-substring start (point)))))))
|
||||
|
||||
|
||||
|
||||
;;; MH-E images
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile (defvar image-load-path))
|
||||
|
||||
(defvar mh-image-load-path-called-flag nil)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-image-load-path ()
|
||||
"Ensure that the MH-E images are accessible by `find-image'.
|
||||
Images for MH-E are found in ../../etc/images relative to the
|
||||
files in \"lisp/mh-e\". If `image-load-path' exists (since Emacs
|
||||
22), then the images directory is added to it if isn't already
|
||||
there. Otherwise, the images directory is added to the
|
||||
`load-path' if it isn't already there."
|
||||
(unless mh-image-load-path-called-flag
|
||||
(let (mh-library-name mh-image-load-path)
|
||||
;; First, find mh-e in the load-path.
|
||||
(setq mh-library-name (locate-library "mh-e"))
|
||||
(if (not mh-library-name)
|
||||
(error "Can not find MH-E in load-path"))
|
||||
(setq mh-image-load-path
|
||||
(expand-file-name (concat (file-name-directory mh-library-name)
|
||||
"../../etc/images")))
|
||||
(if (not (file-exists-p mh-image-load-path))
|
||||
(error "Can not find image directory %s" mh-image-load-path))
|
||||
(if (boundp 'image-load-path)
|
||||
(add-to-list 'image-load-path mh-image-load-path)
|
||||
(add-to-list 'load-path mh-image-load-path)))
|
||||
(setq mh-image-load-path-called-flag t)))
|
||||
|
||||
|
||||
|
||||
;;; Support routines for mh-customize.el
|
||||
|
||||
(defvar mh-min-colors-defined-flag (and (not mh-xemacs-flag)
|
||||
(>= emacs-major-version 22))
|
||||
"Non-nil means defface supports min-colors display requirement.")
|
||||
|
||||
(defun mh-defface-compat (spec)
|
||||
"Convert SPEC for defface if necessary to run on older platforms.
|
||||
Modifies SPEC in place and returns it. See `defface' for the spec definition.
|
||||
|
||||
When `mh-min-colors-defined-flag' is nil, this function finds
|
||||
display entries with \"min-colors\" requirements and either
|
||||
removes the \"min-colors\" requirement or strips the display
|
||||
entirely if the display does not support the number of specified
|
||||
colors."
|
||||
(if mh-min-colors-defined-flag
|
||||
spec
|
||||
(let ((cells (display-color-cells))
|
||||
new-spec)
|
||||
;; Remove entries with min-colors, or delete them if we have fewer colors
|
||||
;; than they specify.
|
||||
(loop for entry in (reverse spec) do
|
||||
(let ((requirement (if (eq (car entry) t)
|
||||
nil
|
||||
(assoc 'min-colors (car entry)))))
|
||||
(if requirement
|
||||
(when (>= cells (nth 1 requirement))
|
||||
(setq new-spec (cons (cons (delq requirement (car entry))
|
||||
(cdr entry))
|
||||
new-spec)))
|
||||
(setq new-spec (cons entry new-spec)))))
|
||||
new-spec)))
|
||||
|
||||
(provide 'mh-init)
|
||||
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; sentence-end-double-space: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: e8372aeb-d803-42b1-9c95-3c93ad22f63c
|
||||
;;; mh-init.el ends here
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
;;; mh-junk.el --- Interface to anti-spam measures
|
||||
;;; mh-junk.el --- MH-E interface to anti-spam measures
|
||||
|
||||
;; Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -32,14 +32,10 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
;;(message "< mh-junk")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
(mh-require-cl)
|
||||
(require 'mh-buffers)
|
||||
(require 'mh-e)
|
||||
;;(message "> mh-junk")
|
||||
(require 'mh-scan)
|
||||
(mh-require-cl)
|
||||
|
||||
;; Interactive functions callable from the folder buffer
|
||||
;;;###mh-autoload
|
||||
(defun mh-junk-blacklist (range)
|
||||
"Blacklist RANGE as spam.
|
||||
|
|
@ -108,6 +104,7 @@ RANGE is read in interactive use."
|
|||
(defvar mh-spamassassin-executable (executable-find "spamassassin"))
|
||||
(defvar mh-sa-learn-executable (executable-find "sa-learn"))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-spamassassin-blacklist (msg)
|
||||
"Blacklist MSG with SpamAssassin.
|
||||
|
||||
|
|
@ -189,7 +186,7 @@ SpamAssassin, rebuilds the database after adding words, so you
|
|||
will need to run \"sa-learn --rebuild\" periodically. This can be
|
||||
done by adding the following to your crontab:
|
||||
|
||||
0 * * * * sa-learn --rebuild > /dev/null 2>&1"
|
||||
0 * * * * sa-learn --rebuild > /dev/null 2>&1"
|
||||
(unless mh-spamassassin-executable
|
||||
(error "Unable to find the spamassassin executable"))
|
||||
(let ((current-folder mh-current-folder)
|
||||
|
|
@ -220,6 +217,7 @@ done by adding the following to your crontab:
|
|||
(message "Blacklisting message %d...done" msg))
|
||||
(message "Blacklisting message %d...not done (from my address)" msg)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-spamassassin-whitelist (msg)
|
||||
"Whitelist MSG with SpamAssassin.
|
||||
|
||||
|
|
@ -273,6 +271,7 @@ The name of the rule is RULE and its body is BODY."
|
|||
(if (not buffer-exists)
|
||||
(kill-buffer nil)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-spamassassin-identify-spammers ()
|
||||
"Identify spammers who are repeat offenders.
|
||||
|
||||
|
|
@ -322,6 +321,7 @@ information can be used so that you can replace multiple
|
|||
|
||||
(defvar mh-bogofilter-executable (executable-find "bogofilter"))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-bogofilter-blacklist (msg)
|
||||
"Blacklist MSG with bogofilter.
|
||||
|
||||
|
|
@ -375,6 +375,7 @@ The \"Bogofilter tuning HOWTO\" describes how you can fine-tune Bogofilter."
|
|||
(call-process mh-bogofilter-executable msg-file mh-junk-background
|
||||
nil "-s")))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-bogofilter-whitelist (msg)
|
||||
"Whitelist MSG with bogofilter.
|
||||
|
||||
|
|
@ -391,6 +392,7 @@ See `mh-bogofilter-blacklist' for more information."
|
|||
|
||||
(defvar mh-spamprobe-executable (executable-find "spamprobe"))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-spamprobe-blacklist (msg)
|
||||
"Blacklist MSG with SpamProbe.
|
||||
|
||||
|
|
@ -421,6 +423,7 @@ update SpamProbe's training."
|
|||
(call-process mh-spamprobe-executable msg-file mh-junk-background
|
||||
nil "spam")))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-spamprobe-whitelist (msg)
|
||||
"Whitelist MSG with SpamProbe.
|
||||
|
||||
|
|
|
|||
966
lisp/mh-e/mh-letter.el
Normal file
966
lisp/mh-e/mh-letter.el
Normal file
|
|
@ -0,0 +1,966 @@
|
|||
;;; mh-letter.el --- MH-Letter mode
|
||||
|
||||
;; Copyright (C) 1993, 1995, 1997,
|
||||
;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Bill Wohler <wohler@newt.com>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Mode for composing and sending a draft message.
|
||||
|
||||
;; Functions that would ordinarily be in here that are needed by
|
||||
;; mh-show.el should be placed in the Message Utilities section in
|
||||
;; mh-utils.el. That will help prevent the loading of this file until
|
||||
;; a message is actually composed.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mh-e)
|
||||
|
||||
(require 'gnus-util)
|
||||
|
||||
;; Dynamically-created function not found in mh-loaddefs.el.
|
||||
(autoload 'mh-tool-bar-letter-buttons-init "mh-tool-bar")
|
||||
|
||||
(autoload 'mml-insert-tag "mml")
|
||||
|
||||
;;; Variables
|
||||
|
||||
(defvar mh-letter-complete-function-alist
|
||||
'((bcc . mh-alias-letter-expand-alias)
|
||||
(cc . mh-alias-letter-expand-alias)
|
||||
(dcc . mh-alias-letter-expand-alias)
|
||||
(fcc . mh-folder-expand-at-point)
|
||||
(from . mh-alias-letter-expand-alias)
|
||||
(mail-followup-to . mh-alias-letter-expand-alias)
|
||||
(mail-reply-to . mh-alias-letter-expand-alias)
|
||||
(reply-to . mh-alias-letter-expand-alias)
|
||||
(to . mh-alias-letter-expand-alias))
|
||||
"Alist of header fields and completion functions to use.")
|
||||
|
||||
(defvar mh-yank-hooks nil
|
||||
"Obsolete hook for modifying a citation just inserted in the mail buffer.
|
||||
|
||||
Each hook function can find the citation between point and mark.
|
||||
And each hook function should leave point and mark around the
|
||||
citation text as modified.
|
||||
|
||||
This is a normal hook, misnamed for historical reasons. It is
|
||||
semi-obsolete and is only used if `mail-citation-hook' is nil.")
|
||||
|
||||
|
||||
|
||||
;;; Letter Menu
|
||||
|
||||
(easy-menu-define
|
||||
mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
|
||||
'("Letter"
|
||||
["Send This Draft" mh-send-letter t]
|
||||
["Split Current Line" mh-open-line t]
|
||||
["Check Recipient" mh-check-whom t]
|
||||
["Yank Current Message" mh-yank-cur-msg t]
|
||||
["Insert a Message..." mh-insert-letter t]
|
||||
["Insert Signature" mh-insert-signature t]
|
||||
("Encrypt/Sign Message"
|
||||
["Sign Message"
|
||||
mh-mml-secure-message-sign mh-pgp-support-flag]
|
||||
["Encrypt Message"
|
||||
mh-mml-secure-message-encrypt mh-pgp-support-flag]
|
||||
["Sign+Encrypt Message"
|
||||
mh-mml-secure-message-signencrypt mh-pgp-support-flag]
|
||||
["Disable Security"
|
||||
mh-mml-unsecure-message mh-pgp-support-flag]
|
||||
"--"
|
||||
"Security Method"
|
||||
["PGP (MIME)" (setq mh-mml-method-default "pgpmime")
|
||||
:style radio
|
||||
:selected (equal mh-mml-method-default "pgpmime")]
|
||||
["PGP" (setq mh-mml-method-default "pgp")
|
||||
:style radio
|
||||
:selected (equal mh-mml-method-default "pgp")]
|
||||
["S/MIME" (setq mh-mml-method-default "smime")
|
||||
:style radio
|
||||
:selected (equal mh-mml-method-default "smime")]
|
||||
"--"
|
||||
["Save Method as Default"
|
||||
(customize-save-variable 'mh-mml-method-default mh-mml-method-default) t]
|
||||
)
|
||||
["Compose Insertion..." mh-compose-insertion t]
|
||||
["Compose Compressed tar (MH)..."
|
||||
mh-mh-compose-external-compressed-tar t]
|
||||
["Compose Get File (MH)..." mh-mh-compose-anon-ftp t]
|
||||
["Compose Forward..." mh-compose-forward t]
|
||||
;; The next two will have to be merged. But I also need to make sure the
|
||||
;; user can't mix tags of both types.
|
||||
["Pull in All Compositions (MH)"
|
||||
mh-mh-to-mime (mh-mh-directive-present-p)]
|
||||
["Pull in All Compositions (MML)"
|
||||
mh-mml-to-mime (mh-mml-tag-present-p)]
|
||||
["Revert to Non-MIME Edit (MH)"
|
||||
mh-mh-to-mime-undo (equal mh-compose-insertion 'mh)]
|
||||
["Kill This Draft" mh-fully-kill-draft t]))
|
||||
|
||||
|
||||
|
||||
;;; MH-Letter Keys
|
||||
|
||||
;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
|
||||
(gnus-define-keys mh-letter-mode-map
|
||||
" " mh-letter-complete-or-space
|
||||
"," mh-letter-confirm-address
|
||||
"\C-c?" mh-help
|
||||
"\C-c\C-\\" mh-fully-kill-draft ;if no C-q
|
||||
"\C-c\C-^" mh-insert-signature ;if no C-s
|
||||
"\C-c\C-c" mh-send-letter
|
||||
"\C-c\C-d" mh-insert-identity
|
||||
"\C-c\C-e" mh-mh-to-mime
|
||||
"\C-c\C-f\C-a" mh-to-field
|
||||
"\C-c\C-f\C-b" mh-to-field
|
||||
"\C-c\C-f\C-c" mh-to-field
|
||||
"\C-c\C-f\C-d" mh-to-field
|
||||
"\C-c\C-f\C-f" mh-to-fcc
|
||||
"\C-c\C-f\C-l" mh-to-field
|
||||
"\C-c\C-f\C-m" mh-to-field
|
||||
"\C-c\C-f\C-r" mh-to-field
|
||||
"\C-c\C-f\C-s" mh-to-field
|
||||
"\C-c\C-f\C-t" mh-to-field
|
||||
"\C-c\C-fa" mh-to-field
|
||||
"\C-c\C-fb" mh-to-field
|
||||
"\C-c\C-fc" mh-to-field
|
||||
"\C-c\C-fd" mh-to-field
|
||||
"\C-c\C-ff" mh-to-fcc
|
||||
"\C-c\C-fl" mh-to-field
|
||||
"\C-c\C-fm" mh-to-field
|
||||
"\C-c\C-fr" mh-to-field
|
||||
"\C-c\C-fs" mh-to-field
|
||||
"\C-c\C-ft" mh-to-field
|
||||
"\C-c\C-i" mh-insert-letter
|
||||
"\C-c\C-m\C-e" mh-mml-secure-message-encrypt
|
||||
"\C-c\C-m\C-f" mh-compose-forward
|
||||
"\C-c\C-m\C-g" mh-mh-compose-anon-ftp
|
||||
"\C-c\C-m\C-i" mh-compose-insertion
|
||||
"\C-c\C-m\C-m" mh-mml-to-mime
|
||||
"\C-c\C-m\C-n" mh-mml-unsecure-message
|
||||
"\C-c\C-m\C-s" mh-mml-secure-message-sign
|
||||
"\C-c\C-m\C-t" mh-mh-compose-external-compressed-tar
|
||||
"\C-c\C-m\C-u" mh-mh-to-mime-undo
|
||||
"\C-c\C-m\C-x" mh-mh-compose-external-type
|
||||
"\C-c\C-mee" mh-mml-secure-message-encrypt
|
||||
"\C-c\C-mes" mh-mml-secure-message-signencrypt
|
||||
"\C-c\C-mf" mh-compose-forward
|
||||
"\C-c\C-mg" mh-mh-compose-anon-ftp
|
||||
"\C-c\C-mi" mh-compose-insertion
|
||||
"\C-c\C-mm" mh-mml-to-mime
|
||||
"\C-c\C-mn" mh-mml-unsecure-message
|
||||
"\C-c\C-mse" mh-mml-secure-message-signencrypt
|
||||
"\C-c\C-mss" mh-mml-secure-message-sign
|
||||
"\C-c\C-mt" mh-mh-compose-external-compressed-tar
|
||||
"\C-c\C-mu" mh-mh-to-mime-undo
|
||||
"\C-c\C-mx" mh-mh-compose-external-type
|
||||
"\C-c\C-o" mh-open-line
|
||||
"\C-c\C-q" mh-fully-kill-draft
|
||||
"\C-c\C-s" mh-insert-signature
|
||||
"\C-c\C-t" mh-letter-toggle-header-field-display
|
||||
"\C-c\C-w" mh-check-whom
|
||||
"\C-c\C-y" mh-yank-cur-msg
|
||||
"\C-c\M-d" mh-insert-auto-fields
|
||||
"\M-\t" mh-letter-complete
|
||||
"\t" mh-letter-next-header-field-or-indent
|
||||
[backtab] mh-letter-previous-header-field)
|
||||
|
||||
;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
|
||||
|
||||
|
||||
|
||||
;;; MH-Letter Help Messages
|
||||
|
||||
;; Group messages logically, more or less.
|
||||
(defvar mh-letter-mode-help-messages
|
||||
'((nil
|
||||
"Send letter: \\[mh-send-letter] "
|
||||
"Open line: \\[mh-open-line]\n"
|
||||
"Kill letter: \\[mh-fully-kill-draft] "
|
||||
"Check recipients: \\[mh-check-whom]\n\n"
|
||||
"Insert:\n"
|
||||
" Current message: \\[mh-yank-cur-msg]\n"
|
||||
" Attachment: \\[mh-compose-insertion]\n"
|
||||
" Message to forward: \\[mh-compose-forward]\n"
|
||||
" Signature: \\[mh-insert-signature]\n\n"
|
||||
"Security:\n"
|
||||
" Encrypt message: \\[mh-mml-secure-message-encrypt]\n"
|
||||
" Sign message: \\[mh-mml-secure-message-sign]\n"
|
||||
" Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]"))
|
||||
"Key binding cheat sheet.
|
||||
|
||||
This is an associative array which is used to show the most
|
||||
common commands. The key is a prefix char. The value is one or
|
||||
more strings which are concatenated together and displayed in the
|
||||
minibuffer if ? is pressed after the prefix character. The
|
||||
special key nil is used to display the non-prefixed commands.
|
||||
|
||||
The substitutions described in `substitute-command-keys' are
|
||||
performed as well.")
|
||||
|
||||
|
||||
|
||||
;;; MH-Letter Font Lock
|
||||
|
||||
(defvar mh-letter-font-lock-keywords
|
||||
`(,@(mh-show-font-lock-keywords-with-cite)
|
||||
(mh-font-lock-field-data
|
||||
(1 'mh-letter-header-field prepend t)))
|
||||
"Additional expressions to highlight in MH-Letter buffers.")
|
||||
|
||||
(defun mh-font-lock-field-data (limit)
|
||||
"Find header field region between point and LIMIT."
|
||||
(and (< (point) (mh-letter-header-end))
|
||||
(< (point) limit)
|
||||
(let ((end (min limit (mh-letter-header-end)))
|
||||
(point (point))
|
||||
data-end data-begin field)
|
||||
(end-of-line)
|
||||
(setq data-end (if (re-search-forward "^[^ \t]" end t)
|
||||
(match-beginning 0)
|
||||
end))
|
||||
(goto-char (1- data-end))
|
||||
(if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t))
|
||||
(setq data-begin (point-min))
|
||||
(setq data-begin (match-end 0))
|
||||
(setq field (match-string 1)))
|
||||
(setq data-begin (max point data-begin))
|
||||
(goto-char (if (equal point data-end) (1+ data-end) data-end))
|
||||
(cond ((and field (mh-letter-skipped-header-field-p field))
|
||||
(set-match-data nil)
|
||||
nil)
|
||||
(t (set-match-data
|
||||
(list data-begin data-end data-begin data-end))
|
||||
t)))))
|
||||
|
||||
(defun mh-letter-header-end ()
|
||||
"Find the end of the message header.
|
||||
This function is to be used only for font locking. It works by
|
||||
searching for `mh-mail-header-separator' in the buffer."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(cond ((equal mh-mail-header-separator "") (point-min))
|
||||
((search-forward (format "\n%s\n" mh-mail-header-separator) nil t)
|
||||
(line-beginning-position 0))
|
||||
(t (point-min)))))
|
||||
|
||||
|
||||
|
||||
;;; MH-Letter Mode
|
||||
|
||||
(defvar mh-letter-buttons-init-flag nil)
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile (mh-do-in-xemacs (defvar font-lock-defaults)))
|
||||
|
||||
;; Ensure new buffers won't get this mode if default-major-mode is nil.
|
||||
(put 'mh-letter-mode 'mode-class 'special)
|
||||
|
||||
;;;###mh-autoload
|
||||
(define-derived-mode mh-letter-mode mail-mode "MH-Letter"
|
||||
"Mode for composing letters in MH-E\\<mh-letter-mode-map>.
|
||||
|
||||
When you have finished composing, type \\[mh-send-letter] to send
|
||||
the message using the MH mail handling system.
|
||||
|
||||
There are two types of tags used by MH-E when composing MIME
|
||||
messages: MML and MH. The option `mh-compose-insertion' controls
|
||||
what type of tags are inserted by MH-E commands. These tags can
|
||||
be converted to MIME body parts by running \\[mh-mh-to-mime] for
|
||||
MH-style directives or \\[mh-mml-to-mime] for MML tags.
|
||||
|
||||
Options that control this mode can be changed with
|
||||
\\[customize-group]; specify the \"mh-compose\" group.
|
||||
|
||||
When a message is composed, the hooks `text-mode-hook',
|
||||
`mail-mode-hook', and `mh-letter-mode-hook' are run (in that
|
||||
order).
|
||||
|
||||
\\{mh-letter-mode-map}"
|
||||
(mh-find-path)
|
||||
(make-local-variable 'mh-send-args)
|
||||
(make-local-variable 'mh-annotate-char)
|
||||
(make-local-variable 'mh-annotate-field)
|
||||
(make-local-variable 'mh-previous-window-config)
|
||||
(make-local-variable 'mh-sent-from-folder)
|
||||
(make-local-variable 'mh-sent-from-msg)
|
||||
(mh-do-in-gnu-emacs
|
||||
(unless mh-letter-buttons-init-flag
|
||||
(mh-tool-bar-letter-buttons-init)
|
||||
(setq mh-letter-buttons-init-flag t)))
|
||||
;; Set the local value of mh-mail-header-separator according to what is
|
||||
;; present in the buffer...
|
||||
(set (make-local-variable 'mh-mail-header-separator)
|
||||
(save-excursion
|
||||
(goto-char (mh-mail-header-end))
|
||||
(buffer-substring-no-properties (point) (line-end-position))))
|
||||
(make-local-variable 'mail-header-separator)
|
||||
(setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
|
||||
(mh-set-help mh-letter-mode-help-messages)
|
||||
(setq buffer-invisibility-spec '((vanish . t) t))
|
||||
(set (make-local-variable 'line-move-ignore-invisible) t)
|
||||
|
||||
;; Enable undo since a show-mode buffer might have been reused.
|
||||
(buffer-enable-undo)
|
||||
(set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)
|
||||
(mh-funcall-if-exists mh-tool-bar-init :letter)
|
||||
(make-local-variable 'font-lock-defaults)
|
||||
(cond
|
||||
((or (equal mh-highlight-citation-style 'font-lock)
|
||||
(equal mh-highlight-citation-style 'gnus))
|
||||
;; Let's use font-lock even if gnus is used in show-mode. The reason
|
||||
;; is that gnus uses static text properties which are not appropriate
|
||||
;; for a buffer that will be edited. So the choice here is either fontify
|
||||
;; the citations and header...
|
||||
(setq font-lock-defaults '(mh-letter-font-lock-keywords t)))
|
||||
(t
|
||||
;; ...or the header only
|
||||
(setq font-lock-defaults '((mh-show-font-lock-keywords) t))))
|
||||
(easy-menu-add mh-letter-menu)
|
||||
;; Maybe we want to use the existing Mail menu from mail-mode in
|
||||
;; 9.0; in the mean time, let's remove it since the redundancy will
|
||||
;; only produce confusion.
|
||||
(define-key mh-letter-mode-map [menu-bar mail] 'undefined)
|
||||
(mh-do-in-xemacs (easy-menu-remove mail-menubar-menu))
|
||||
(setq fill-column mh-letter-fill-column)
|
||||
;; If text-mode-hook turned on auto-fill, tune it for messages
|
||||
(when auto-fill-function
|
||||
(make-local-variable 'auto-fill-function)
|
||||
(setq auto-fill-function 'mh-auto-fill-for-letter)))
|
||||
|
||||
|
||||
|
||||
;;; MH-Letter Commands
|
||||
|
||||
;; Alphabetical.
|
||||
;; See also mh-comp.el and mh-mime.el.
|
||||
|
||||
(defun mh-check-whom ()
|
||||
"Verify recipients, showing expansion of any aliases.
|
||||
|
||||
This command expands aliases so you can check the actual address(es)
|
||||
in the alias. A new buffer named \"*MH-E Recipients*\" is created with
|
||||
the output of \"whom\"."
|
||||
(interactive)
|
||||
(let ((file-name buffer-file-name))
|
||||
(save-buffer)
|
||||
(message "Checking recipients...")
|
||||
(mh-in-show-buffer (mh-recipients-buffer)
|
||||
(bury-buffer (current-buffer))
|
||||
(erase-buffer)
|
||||
(mh-exec-cmd-output "whom" t file-name))
|
||||
(message "Checking recipients...done")))
|
||||
|
||||
(defun mh-insert-letter (folder message verbatim)
|
||||
"Insert a message.
|
||||
|
||||
This command prompts you for the FOLDER and MESSAGE number, which
|
||||
defaults to the current message in that folder. It then inserts
|
||||
the message, indented by `mh-ins-buf-prefix' (\"> \") unless
|
||||
`mh-yank-behavior' is set to one of the supercite flavors in
|
||||
which case supercite is used to format the message. Certain
|
||||
undesirable header fields (see
|
||||
`mh-invisible-header-fields-compiled') are removed before
|
||||
insertion.
|
||||
|
||||
If given a prefix argument VERBATIM, the header is left intact, the
|
||||
message is not indented, and \"> \" is not inserted before each line.
|
||||
This command leaves the mark before the letter and point after it."
|
||||
(interactive
|
||||
(let* ((folder
|
||||
(mh-prompt-for-folder "Message from"
|
||||
mh-sent-from-folder nil))
|
||||
(default
|
||||
(if (and (equal folder mh-sent-from-folder)
|
||||
(numberp mh-sent-from-msg))
|
||||
mh-sent-from-msg
|
||||
(nth 0 (mh-translate-range folder "cur"))))
|
||||
(message
|
||||
(read-string (concat "Message number"
|
||||
(or (and default
|
||||
(format " (default %d): " default))
|
||||
": ")))))
|
||||
(list folder message current-prefix-arg)))
|
||||
(save-restriction
|
||||
(narrow-to-region (point) (point))
|
||||
(let ((start (point-min)))
|
||||
(if (and (equal message "") (numberp mh-sent-from-msg))
|
||||
(setq message (int-to-string mh-sent-from-msg)))
|
||||
(insert-file-contents
|
||||
(expand-file-name message (mh-expand-file-name folder)))
|
||||
(when (not verbatim)
|
||||
(mh-clean-msg-header start mh-invisible-header-fields-compiled nil)
|
||||
(goto-char (point-max)) ;Needed for sc-cite-original
|
||||
(push-mark) ;Needed for sc-cite-original
|
||||
(goto-char (point-min)) ;Needed for sc-cite-original
|
||||
(mh-insert-prefix-string mh-ins-buf-prefix)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-insert-signature (&optional file)
|
||||
"Insert signature in message.
|
||||
|
||||
This command inserts your signature at the current cursor location.
|
||||
|
||||
By default, the text of your signature is taken from the file
|
||||
\"~/.signature\". You can read from other sources by changing the
|
||||
option `mh-signature-file-name'.
|
||||
|
||||
A signature separator (\"-- \") will be added if the signature block
|
||||
does not contain one and `mh-signature-separator-flag' is on.
|
||||
|
||||
The hook `mh-insert-signature-hook' is run after the signature is
|
||||
inserted. Hook functions may access the actual name of the file or the
|
||||
function used to insert the signature with `mh-signature-file-name'.
|
||||
|
||||
The signature can also be inserted using Identities (see
|
||||
`mh-identity-list').
|
||||
|
||||
In a program, you can pass in a signature FILE."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(insert "\n")
|
||||
(let ((mh-signature-file-name (or file mh-signature-file-name))
|
||||
(mh-mh-p (mh-mh-directive-present-p))
|
||||
(mh-mml-p (mh-mml-tag-present-p)))
|
||||
(save-restriction
|
||||
(narrow-to-region (point) (point))
|
||||
(cond
|
||||
((mh-file-is-vcard-p mh-signature-file-name)
|
||||
(if (equal mh-compose-insertion 'mml)
|
||||
(insert "<#part type=\"text/x-vcard\" filename=\""
|
||||
mh-signature-file-name
|
||||
"\" disposition=inline description=VCard>\n<#/part>")
|
||||
(insert "#text/x-vcard; name=\""
|
||||
(file-name-nondirectory mh-signature-file-name)
|
||||
"\" [VCard] " (expand-file-name mh-signature-file-name))))
|
||||
(t
|
||||
(cond
|
||||
(mh-mh-p
|
||||
(insert "#\n" "Content-Description: Signature\n"))
|
||||
(mh-mml-p
|
||||
(mml-insert-tag 'part 'type "text/plain" 'disposition "inline"
|
||||
'description "Signature")))
|
||||
(cond ((null mh-signature-file-name))
|
||||
((and (stringp mh-signature-file-name)
|
||||
(file-readable-p mh-signature-file-name))
|
||||
(insert-file-contents mh-signature-file-name))
|
||||
((functionp mh-signature-file-name)
|
||||
(funcall mh-signature-file-name)))))
|
||||
(save-restriction
|
||||
(widen)
|
||||
(run-hooks 'mh-insert-signature-hook))
|
||||
(goto-char (point-min))
|
||||
(when (and (not (mh-file-is-vcard-p mh-signature-file-name))
|
||||
mh-signature-separator-flag
|
||||
(> (point-max) (point-min))
|
||||
(not (mh-signature-separator-p)))
|
||||
(cond (mh-mh-p
|
||||
(forward-line 2))
|
||||
(mh-mml-p
|
||||
(forward-line 1)))
|
||||
(insert mh-signature-separator))
|
||||
(if (not (> (point-max) (point-min)))
|
||||
(message "No signature found")))))
|
||||
(force-mode-line-update))
|
||||
|
||||
(defun mh-letter-complete (arg)
|
||||
"Perform completion on header field or word preceding point.
|
||||
|
||||
If the field contains addresses (for example, \"To:\" or \"Cc:\")
|
||||
or folders (for example, \"Fcc:\") then this command will provide
|
||||
alias completion. In the body of the message, this command runs
|
||||
`mh-letter-complete-function' instead, which is set to
|
||||
`ispell-complete-word' by default. This command takes a prefix
|
||||
argument ARG that is passed to the
|
||||
`mh-letter-complete-function'."
|
||||
(interactive "P")
|
||||
(let ((func nil))
|
||||
(cond ((not (mh-in-header-p))
|
||||
(funcall mh-letter-complete-function arg))
|
||||
((setq func (cdr (assoc (mh-letter-header-field-at-point)
|
||||
mh-letter-complete-function-alist)))
|
||||
(funcall func))
|
||||
(t (funcall mh-letter-complete-function arg)))))
|
||||
|
||||
(defun mh-letter-complete-or-space (arg)
|
||||
"Perform completion or insert space.
|
||||
|
||||
Turn on the option `mh-compose-space-does-completion-flag' to use
|
||||
this command to perform completion in the header. Otherwise, a
|
||||
space is inserted; use a prefix argument ARG to specify more than
|
||||
one space."
|
||||
(interactive "p")
|
||||
(let ((func nil)
|
||||
(end-of-prev (save-excursion
|
||||
(goto-char (mh-beginning-of-word))
|
||||
(mh-beginning-of-word -1))))
|
||||
(cond ((not mh-compose-space-does-completion-flag)
|
||||
(self-insert-command arg))
|
||||
((not (mh-in-header-p)) (self-insert-command arg))
|
||||
((> (point) end-of-prev) (self-insert-command arg))
|
||||
((setq func (cdr (assoc (mh-letter-header-field-at-point)
|
||||
mh-letter-complete-function-alist)))
|
||||
(funcall func))
|
||||
(t (self-insert-command arg)))))
|
||||
|
||||
(defun mh-letter-confirm-address ()
|
||||
"Flash alias expansion.
|
||||
|
||||
Addresses are separated by a comma\; when you press the comma,
|
||||
this command flashes the alias expansion in the minibuffer if
|
||||
`mh-alias-flash-on-comma' is turned on."
|
||||
(interactive)
|
||||
(cond ((not (mh-in-header-p)) (self-insert-command 1))
|
||||
((eq (cdr (assoc (mh-letter-header-field-at-point)
|
||||
mh-letter-complete-function-alist))
|
||||
'mh-alias-letter-expand-alias)
|
||||
(mh-alias-reload-maybe)
|
||||
(mh-alias-minibuffer-confirm-address))
|
||||
(t (self-insert-command 1))))
|
||||
|
||||
(defun mh-letter-next-header-field-or-indent (arg)
|
||||
"Cycle to next field.
|
||||
|
||||
Within the header of the message, this command moves between
|
||||
fields that are highlighted with the face
|
||||
`mh-letter-header-field', skipping those fields listed in
|
||||
`mh-compose-skipped-header-fields'. After the last field, this
|
||||
command then moves point to the message body before cycling back
|
||||
to the first field. If point is already past the first line of
|
||||
the message body, then this command indents by calling
|
||||
`indent-relative' with the given prefix argument ARG."
|
||||
(interactive "P")
|
||||
(let ((header-end (save-excursion
|
||||
(goto-char (mh-mail-header-end))
|
||||
(forward-line)
|
||||
(point))))
|
||||
(if (> (point) header-end)
|
||||
(indent-relative arg)
|
||||
(mh-letter-next-header-field))))
|
||||
|
||||
(defun mh-letter-previous-header-field ()
|
||||
"Cycle to the previous header field.
|
||||
|
||||
This command moves backwards between the fields and cycles to the
|
||||
body of the message after the first field. Unlike the command
|
||||
\\[mh-letter-next-header-field-or-indent], it will always take
|
||||
point to the last field from anywhere in the body."
|
||||
(interactive)
|
||||
(let ((header-end (mh-mail-header-end)))
|
||||
(if (>= (point) header-end)
|
||||
(goto-char header-end)
|
||||
(mh-header-field-beginning))
|
||||
(cond ((re-search-backward mh-letter-header-field-regexp nil t)
|
||||
(if (mh-letter-skipped-header-field-p (match-string 1))
|
||||
(mh-letter-previous-header-field)
|
||||
(goto-char (match-end 0))
|
||||
(mh-letter-skip-leading-whitespace-in-header-field)))
|
||||
(t (goto-char header-end)
|
||||
(forward-line)))))
|
||||
|
||||
(defun mh-open-line ()
|
||||
"Insert a newline and leave point before it.
|
||||
|
||||
This command is similar to the command \\[open-line] in that it
|
||||
inserts a newline after point. It differs in that it also inserts
|
||||
the right number of quoting characters and spaces so that the
|
||||
next line begins in the same column as it was. This is useful
|
||||
when breaking up paragraphs in replies."
|
||||
(interactive)
|
||||
(let ((column (current-column))
|
||||
(prefix (mh-current-fill-prefix)))
|
||||
(if (> (length prefix) column)
|
||||
(message "Sorry, point seems to be within the line prefix")
|
||||
(newline 2)
|
||||
(insert prefix)
|
||||
(while (> column (current-column))
|
||||
(insert " "))
|
||||
(forward-line -1))))
|
||||
|
||||
(defun mh-to-fcc (&optional folder)
|
||||
"Move to \"Fcc:\" header field.
|
||||
|
||||
This command will prompt you for the FOLDER name in which to file
|
||||
a copy of the draft."
|
||||
(interactive (list (mh-prompt-for-folder
|
||||
"Fcc"
|
||||
(or (and mh-default-folder-for-message-function
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(funcall
|
||||
mh-default-folder-for-message-function)))
|
||||
"")
|
||||
t)))
|
||||
(let ((last-input-char ?\C-f))
|
||||
(expand-abbrev)
|
||||
(save-excursion
|
||||
(mh-to-field)
|
||||
(insert (if (mh-folder-name-p folder)
|
||||
(substring folder 1)
|
||||
folder)))))
|
||||
|
||||
(defvar mh-to-field-choices '(("a" . "Mail-Reply-To:")
|
||||
("b" . "Bcc:")
|
||||
("c" . "Cc:")
|
||||
("d" . "Dcc:")
|
||||
("f" . "Fcc:")
|
||||
("l" . "Mail-Followup-To:")
|
||||
("m" . "From:")
|
||||
("r" . "Reply-To:")
|
||||
("s" . "Subject:")
|
||||
("t" . "To:"))
|
||||
"Alist of (final-character . field-name) choices for `mh-to-field'.")
|
||||
|
||||
(defun mh-to-field ()
|
||||
"Move to specified header field.
|
||||
|
||||
The field is indicated by the previous keystroke (the last
|
||||
keystroke of the command) according to the list in the variable
|
||||
`mh-to-field-choices'.
|
||||
Create the field if it does not exist.
|
||||
Set the mark to point before moving."
|
||||
(interactive)
|
||||
(expand-abbrev)
|
||||
(let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
|
||||
mh-to-field-choices)
|
||||
;; also look for a char for version 4 compat
|
||||
(assoc (logior last-input-char ?`)
|
||||
mh-to-field-choices))))
|
||||
(case-fold-search t))
|
||||
(push-mark)
|
||||
(cond ((mh-position-on-field target)
|
||||
(let ((eol (point)))
|
||||
(skip-chars-backward " \t")
|
||||
(delete-region (point) eol))
|
||||
(if (and (not (eq (logior last-input-char ?`) ?s))
|
||||
(save-excursion
|
||||
(backward-char 1)
|
||||
(not (looking-at "[:,]"))))
|
||||
(insert ", ")
|
||||
(insert " ")))
|
||||
(t
|
||||
(if (mh-position-on-field "To:")
|
||||
(forward-line 1))
|
||||
(insert (format "%s \n" target))
|
||||
(backward-char 1)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-yank-cur-msg ()
|
||||
"Insert the current message into the draft buffer.
|
||||
|
||||
It is often useful to insert a snippet of text from a letter that
|
||||
someone mailed to provide some context for your reply. This
|
||||
command does this by adding an attribution, yanking a portion of
|
||||
text from the message to which you're replying, and inserting
|
||||
`mh-ins-buf-prefix' (`> ') before each line.
|
||||
|
||||
The attribution consists of the sender's name and email address
|
||||
followed by the content of the option
|
||||
`mh-extract-from-attribution-verb'.
|
||||
|
||||
You can also turn on the option
|
||||
`mh-delete-yanked-msg-window-flag' to delete the window
|
||||
containing the original message after yanking it to make more
|
||||
room on your screen for your reply.
|
||||
|
||||
You can control how the message to which you are replying is
|
||||
yanked into your reply using `mh-yank-behavior'.
|
||||
|
||||
If this isn't enough, you can gain full control over the
|
||||
appearance of the included text by setting `mail-citation-hook'
|
||||
to a function that modifies it. For example, if you set this hook
|
||||
to `trivial-cite' (which is NOT part of Emacs), set
|
||||
`mh-yank-behavior' to \"Body and Header\" (see URL
|
||||
`http://shasta.cs.uiuc.edu/~lrclause/tc.html').
|
||||
|
||||
Note that if `mail-citation-hook' is set, `mh-ins-buf-prefix' is
|
||||
not inserted. If the option `mh-yank-behavior' is set to one of
|
||||
the supercite flavors, the hook `mail-citation-hook' is ignored
|
||||
and `mh-ins-buf-prefix' is not inserted."
|
||||
(interactive)
|
||||
(if (and mh-sent-from-folder
|
||||
(save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer)
|
||||
(save-excursion (set-buffer mh-sent-from-folder)
|
||||
(get-buffer mh-show-buffer))
|
||||
mh-sent-from-msg)
|
||||
(let ((to-point (point))
|
||||
(to-buffer (current-buffer)))
|
||||
(set-buffer mh-sent-from-folder)
|
||||
(if mh-delete-yanked-msg-window-flag
|
||||
(delete-windows-on mh-show-buffer))
|
||||
(set-buffer mh-show-buffer) ; Find displayed message
|
||||
(let* ((from-attr (mh-extract-from-attribution))
|
||||
(yank-region (mh-mark-active-p nil))
|
||||
(mh-ins-str
|
||||
(cond ((and yank-region
|
||||
(or (eq 'supercite mh-yank-behavior)
|
||||
(eq 'autosupercite mh-yank-behavior)
|
||||
(eq t mh-yank-behavior)))
|
||||
;; supercite needs the full header
|
||||
(concat
|
||||
(buffer-substring (point-min) (mh-mail-header-end))
|
||||
"\n"
|
||||
(buffer-substring (region-beginning) (region-end))))
|
||||
(yank-region
|
||||
(buffer-substring (region-beginning) (region-end)))
|
||||
((or (eq 'body mh-yank-behavior)
|
||||
(eq 'attribution mh-yank-behavior)
|
||||
(eq 'autoattrib mh-yank-behavior))
|
||||
(buffer-substring
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(mh-goto-header-end 1)
|
||||
(point))
|
||||
(point-max)))
|
||||
((or (eq 'supercite mh-yank-behavior)
|
||||
(eq 'autosupercite mh-yank-behavior)
|
||||
(eq t mh-yank-behavior))
|
||||
(buffer-substring (point-min) (point-max)))
|
||||
(t
|
||||
(buffer-substring (point) (point-max))))))
|
||||
(set-buffer to-buffer)
|
||||
(save-restriction
|
||||
(narrow-to-region to-point to-point)
|
||||
(insert (mh-filter-out-non-text mh-ins-str))
|
||||
(goto-char (point-max)) ;Needed for sc-cite-original
|
||||
(push-mark) ;Needed for sc-cite-original
|
||||
(goto-char (point-min)) ;Needed for sc-cite-original
|
||||
(mh-insert-prefix-string mh-ins-buf-prefix)
|
||||
(when (or (eq 'attribution mh-yank-behavior)
|
||||
(eq 'autoattrib mh-yank-behavior))
|
||||
(insert from-attr)
|
||||
(mh-identity-insert-attribution-verb nil)
|
||||
(insert "\n\n"))
|
||||
;; If the user has selected a region, he has already "edited" the
|
||||
;; text, so leave the cursor at the end of the yanked text. In
|
||||
;; either case, leave a mark at the opposite end of the included
|
||||
;; text to make it easy to jump or delete to the other end of the
|
||||
;; text.
|
||||
(push-mark)
|
||||
(goto-char (point-max))
|
||||
(if (null yank-region)
|
||||
(mh-exchange-point-and-mark-preserving-active-mark)))))
|
||||
(error "There is no current message")))
|
||||
|
||||
|
||||
|
||||
;;; Support Routines
|
||||
|
||||
(defun mh-auto-fill-for-letter ()
|
||||
"Perform auto-fill for message.
|
||||
Header is treated specially by inserting a tab before continuation
|
||||
lines."
|
||||
(if (mh-in-header-p)
|
||||
(let ((fill-prefix "\t"))
|
||||
(do-auto-fill))
|
||||
(do-auto-fill)))
|
||||
|
||||
(defun mh-filter-out-non-text (string)
|
||||
"Return STRING but without adornments such as MIME buttons and smileys."
|
||||
(with-temp-buffer
|
||||
;; Insert the string to filter
|
||||
(insert string)
|
||||
(goto-char (point-min))
|
||||
|
||||
;; Remove the MIME buttons
|
||||
(let ((can-move-forward t)
|
||||
(in-button nil))
|
||||
(while can-move-forward
|
||||
(cond ((and (not (get-text-property (point) 'mh-data))
|
||||
in-button)
|
||||
(delete-region (1- (point)) (point))
|
||||
(setq in-button nil))
|
||||
((get-text-property (point) 'mh-data)
|
||||
(delete-region (point)
|
||||
(save-excursion (forward-line) (point)))
|
||||
(setq in-button t))
|
||||
(t (setq can-move-forward (= (forward-line) 0))))))
|
||||
|
||||
;; Return the contents without properties... This gets rid of emphasis
|
||||
;; and smileys
|
||||
(buffer-substring-no-properties (point-min) (point-max))))
|
||||
|
||||
(defun mh-current-fill-prefix ()
|
||||
"Return the `fill-prefix' on the current line as a string."
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
;; This assumes that the major-mode sets up adaptive-fill-regexp
|
||||
;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But
|
||||
;; perhaps I should use the variable and simply inserts its value here,
|
||||
;; and set it locally in a let scope. --psg
|
||||
(if (re-search-forward adaptive-fill-regexp nil t)
|
||||
(match-string 0)
|
||||
"")))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-letter-next-header-field ()
|
||||
"Cycle to the next header field.
|
||||
If we are at the last header field go to the start of the message
|
||||
body."
|
||||
(let ((header-end (mh-mail-header-end)))
|
||||
(cond ((>= (point) header-end) (goto-char (point-min)))
|
||||
((< (point) (progn
|
||||
(beginning-of-line)
|
||||
(re-search-forward mh-letter-header-field-regexp
|
||||
(line-end-position) t)
|
||||
(point)))
|
||||
(beginning-of-line))
|
||||
(t (end-of-line)))
|
||||
(cond ((re-search-forward mh-letter-header-field-regexp header-end t)
|
||||
(if (mh-letter-skipped-header-field-p (match-string 1))
|
||||
(mh-letter-next-header-field)
|
||||
(mh-letter-skip-leading-whitespace-in-header-field)))
|
||||
(t (goto-char header-end)
|
||||
(forward-line)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-position-on-field (field &optional ignored)
|
||||
"Move to the end of the FIELD in the header.
|
||||
Move to end of entire header if FIELD not found.
|
||||
Returns non-nil iff FIELD was found.
|
||||
The optional second arg is for pre-version 4 compatibility and is
|
||||
IGNORED."
|
||||
(cond ((mh-goto-header-field field)
|
||||
(mh-header-field-end)
|
||||
t)
|
||||
((mh-goto-header-end 0)
|
||||
nil)))
|
||||
|
||||
(defun mh-letter-header-field-at-point ()
|
||||
"Return the header field name at point.
|
||||
A symbol is returned whose name is the string obtained by
|
||||
downcasing the field name."
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(and (re-search-backward mh-letter-header-field-regexp nil t)
|
||||
(intern (downcase (match-string 1))))))
|
||||
|
||||
(defun mh-folder-expand-at-point ()
|
||||
"Do folder name completion in Fcc header field."
|
||||
(let* ((end (point))
|
||||
(beg (mh-beginning-of-word))
|
||||
(folder (buffer-substring beg end))
|
||||
(leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+)))
|
||||
(last-slash (mh-search-from-end ?/ folder))
|
||||
(prefix (and last-slash (substring folder 0 last-slash)))
|
||||
(choices (mapcar #'(lambda (x)
|
||||
(list (cond (prefix (format "%s/%s" prefix x))
|
||||
(leading-plus (format "+%s" x))
|
||||
(t x))))
|
||||
(mh-folder-completion-function folder nil t))))
|
||||
(mh-complete-word folder choices beg end)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-complete-word (word choices begin end)
|
||||
"Complete WORD at from CHOICES.
|
||||
Any match found replaces the text from BEGIN to END."
|
||||
(let ((completion (try-completion word choices))
|
||||
(completions-buffer "*Completions*"))
|
||||
(cond ((eq completion t)
|
||||
(ignore-errors
|
||||
(kill-buffer completions-buffer))
|
||||
(message "Completed: %s" word))
|
||||
((null completion)
|
||||
(ignore-errors
|
||||
(kill-buffer completions-buffer))
|
||||
(message "No completion for %s" word))
|
||||
((stringp completion)
|
||||
(if (equal word completion)
|
||||
(with-output-to-temp-buffer completions-buffer
|
||||
(mh-display-completion-list (all-completions word choices)
|
||||
word))
|
||||
(ignore-errors
|
||||
(kill-buffer completions-buffer))
|
||||
(delete-region begin end)
|
||||
(insert completion))))))
|
||||
|
||||
(defun mh-file-is-vcard-p (file)
|
||||
"Return t if FILE is a .vcf vcard."
|
||||
(let ((case-fold-search t))
|
||||
(and (stringp file)
|
||||
(file-exists-p file)
|
||||
(or (and (not (mh-have-file-command))
|
||||
(not (null (string-match "\.vcf$" file))))
|
||||
(string-equal "text/x-vcard" (mh-file-mime-type file))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-letter-toggle-header-field-display-button (event)
|
||||
"Toggle header field display at location of EVENT.
|
||||
This function does the same thing as
|
||||
`mh-letter-toggle-header-field-display' except that it is
|
||||
callable from a mouse button."
|
||||
(interactive "e")
|
||||
(mh-do-at-event-location event
|
||||
(mh-letter-toggle-header-field-display nil)))
|
||||
|
||||
(defun mh-extract-from-attribution ()
|
||||
"Extract phrase or comment from From header field."
|
||||
(save-excursion
|
||||
(if (not (mh-goto-header-field "From: "))
|
||||
nil
|
||||
(skip-chars-forward " ")
|
||||
(cond
|
||||
((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
|
||||
(format "%s %s " (match-string 1)(match-string 2)))
|
||||
((looking-at "\\([^<\n]+<.+>\\)$")
|
||||
(format "%s " (match-string 1)))
|
||||
((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
|
||||
(format "%s <%s> " (match-string 2)(match-string 1)))
|
||||
((looking-at " *\\(.+\\)$")
|
||||
(format "%s " (match-string 1)))))))
|
||||
|
||||
(defun mh-insert-prefix-string (mh-ins-string)
|
||||
"Insert prefix string before each line in buffer.
|
||||
The inserted letter is cited using `sc-cite-original' if
|
||||
`mh-yank-behavior' is one of 'supercite or 'autosupercite.
|
||||
Otherwise, simply insert MH-INS-STRING before each line."
|
||||
(goto-char (point-min))
|
||||
(cond ((or (eq mh-yank-behavior 'supercite)
|
||||
(eq mh-yank-behavior 'autosupercite))
|
||||
(sc-cite-original))
|
||||
(mail-citation-hook
|
||||
(run-hooks 'mail-citation-hook))
|
||||
(mh-yank-hooks ;old hook name
|
||||
(run-hooks 'mh-yank-hooks))
|
||||
(t
|
||||
(or (bolp) (forward-line 1))
|
||||
(while (< (point) (point-max))
|
||||
(insert mh-ins-string)
|
||||
(forward-line 1))
|
||||
(goto-char (point-min))))) ;leave point like sc-cite-original
|
||||
|
||||
(provide 'mh-letter)
|
||||
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; sentence-end-double-space: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 0548632c-aadb-4e3b-bb80-bbd62ff90bf3
|
||||
;;; mh-letter.el ends here
|
||||
330
lisp/mh-e/mh-limit.el
Normal file
330
lisp/mh-e/mh-limit.el
Normal file
|
|
@ -0,0 +1,330 @@
|
|||
;;; mh-limit.el --- MH-E display limits
|
||||
|
||||
;; Copyright (C) 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Peter S. Galbraith <psg@debian.org>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;; "Poor man's threading" by psg.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mh-e)
|
||||
(mh-require-cl)
|
||||
(require 'mh-scan)
|
||||
|
||||
(autoload 'message-fetch-field "message")
|
||||
|
||||
|
||||
|
||||
;;; MH-Folder Commands
|
||||
|
||||
;; Alphabetical.
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-delete-subject ()
|
||||
"Delete messages with same subject\\<mh-folder-mode-map>.
|
||||
|
||||
To delete messages faster, you can use this command to delete all
|
||||
the messages with the same subject as the current message. This
|
||||
command puts these messages in a sequence named \"subject\". You
|
||||
can undo this action by using \\[mh-undo] with a prefix argument
|
||||
and then specifying the \"subject\" sequence."
|
||||
(interactive)
|
||||
(let ((count (mh-subject-to-sequence nil)))
|
||||
(cond
|
||||
((not count) ; No subject line, delete msg anyway
|
||||
(mh-delete-msg (mh-get-msg-num t)))
|
||||
((= 0 count) ; No other msgs, delete msg anyway.
|
||||
(message "No other messages with same Subject following this one")
|
||||
(mh-delete-msg (mh-get-msg-num t)))
|
||||
(t ; We have a subject sequence.
|
||||
(message "Marked %d messages for deletion" count)
|
||||
(mh-delete-msg 'subject)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-delete-subject-or-thread ()
|
||||
"Delete messages with same subject or thread\\<mh-folder-mode-map>.
|
||||
|
||||
To delete messages faster, you can use this command to delete all
|
||||
the messages with the same subject as the current message. This
|
||||
command puts these messages in a sequence named \"subject\". You
|
||||
can undo this action by using \\[mh-undo] with a prefix argument
|
||||
and then specifying the \"subject\" sequence.
|
||||
|
||||
However, if the buffer is displaying a threaded view of the
|
||||
folder then this command behaves like \\[mh-thread-delete]."
|
||||
(interactive)
|
||||
(if (memq 'unthread mh-view-ops)
|
||||
(mh-thread-delete)
|
||||
(mh-delete-subject)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-narrow-to-cc (&optional pick-expr)
|
||||
"Limit to messages with the same \"Cc:\" field.
|
||||
With a prefix argument, edit PICK-EXPR.
|
||||
|
||||
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
|
||||
(interactive
|
||||
(list (mh-edit-pick-expr (mh-current-message-header-field 'cc))))
|
||||
(mh-narrow-to-header-field 'cc pick-expr))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-narrow-to-from (&optional pick-expr)
|
||||
"Limit to messages with the same \"From:\" field.
|
||||
With a prefix argument, edit PICK-EXPR.
|
||||
|
||||
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
|
||||
(interactive
|
||||
(list (mh-edit-pick-expr (mh-current-message-header-field 'from))))
|
||||
(mh-narrow-to-header-field 'from pick-expr))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-narrow-to-range (range)
|
||||
"Limit to RANGE.
|
||||
|
||||
Check the documentation of `mh-interactive-range' to see how
|
||||
RANGE is read in interactive use.
|
||||
|
||||
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
|
||||
(interactive (list (mh-interactive-range "Narrow to")))
|
||||
(when (assoc 'range mh-seq-list) (mh-delete-seq 'range))
|
||||
(mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range)
|
||||
(mh-narrow-to-seq 'range))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-narrow-to-subject (&optional pick-expr)
|
||||
"Limit to messages with same subject.
|
||||
With a prefix argument, edit PICK-EXPR.
|
||||
|
||||
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
|
||||
(interactive
|
||||
(list (mh-edit-pick-expr (mh-current-message-header-field 'subject))))
|
||||
(mh-narrow-to-header-field 'subject pick-expr))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-narrow-to-to (&optional pick-expr)
|
||||
"Limit to messages with the same \"To:\" field.
|
||||
With a prefix argument, edit PICK-EXPR.
|
||||
|
||||
Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
|
||||
(interactive
|
||||
(list (mh-edit-pick-expr (mh-current-message-header-field 'to))))
|
||||
(mh-narrow-to-header-field 'to pick-expr))
|
||||
|
||||
|
||||
|
||||
;;; Support Routines
|
||||
|
||||
(defun mh-subject-to-sequence (all)
|
||||
"Put all following messages with same subject in sequence 'subject.
|
||||
If arg ALL is t, move to beginning of folder buffer to collect all
|
||||
messages.
|
||||
If arg ALL is nil, collect only messages fron current one on forward.
|
||||
|
||||
Return number of messages put in the sequence:
|
||||
|
||||
nil -> there was no subject line.
|
||||
|
||||
0 -> there were no later messages with the same
|
||||
subject (sequence not made)
|
||||
|
||||
>1 -> the total number of messages including current one."
|
||||
(if (memq 'unthread mh-view-ops)
|
||||
(mh-subject-to-sequence-threaded all)
|
||||
(mh-subject-to-sequence-unthreaded all)))
|
||||
|
||||
(defun mh-subject-to-sequence-threaded (all)
|
||||
"Put all messages with the same subject in the 'subject sequence.
|
||||
|
||||
This function works when the folder is threaded. In this
|
||||
situation the subject could get truncated and so the normal
|
||||
matching doesn't work.
|
||||
|
||||
The parameter ALL is non-nil then all the messages in the buffer
|
||||
are considered, otherwise only the messages after the current one
|
||||
are taken into account."
|
||||
(let* ((cur (mh-get-msg-num nil))
|
||||
(subject (mh-thread-find-msg-subject cur))
|
||||
region msgs)
|
||||
(if (null subject)
|
||||
(and (message "No subject line") nil)
|
||||
(setq region (cons (if all (point-min) (point)) (point-max)))
|
||||
(mh-iterate-on-range msg region
|
||||
(when (eq (mh-thread-find-msg-subject msg) subject)
|
||||
(push msg msgs)))
|
||||
(setq msgs (sort msgs #'mh-lessp))
|
||||
(if (null msgs)
|
||||
0
|
||||
(when (assoc 'subject mh-seq-list)
|
||||
(mh-delete-seq 'subject))
|
||||
(mh-add-msgs-to-seq msgs 'subject)
|
||||
(length msgs)))))
|
||||
|
||||
(defvar mh-limit-max-subject-size 41
|
||||
"Maximum size of the subject part.
|
||||
It would be desirable to avoid hard-coding this.")
|
||||
|
||||
(defun mh-subject-to-sequence-unthreaded (all)
|
||||
"Put all following messages with same subject in sequence 'subject.
|
||||
|
||||
This function only works with an unthreaded folder. If arg ALL is
|
||||
t, move to beginning of folder buffer to collect all messages. If
|
||||
arg ALL is nil, collect only messages fron current one on
|
||||
forward.
|
||||
|
||||
Return number of messages put in the sequence:
|
||||
|
||||
nil -> there was no subject line.
|
||||
0 -> there were no later messages with the same
|
||||
subject (sequence not made)
|
||||
>1 -> the total number of messages including current one."
|
||||
(if (not (eq major-mode 'mh-folder-mode))
|
||||
(error "Not in a folder buffer"))
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (or (not (looking-at mh-scan-subject-regexp))
|
||||
(not (match-string 3))
|
||||
(string-equal "" (match-string 3)))
|
||||
(progn (message "No subject line")
|
||||
nil)
|
||||
(let ((subject (match-string-no-properties 3))
|
||||
(list))
|
||||
(if (> (length subject) mh-limit-max-subject-size)
|
||||
(setq subject (substring subject 0 mh-limit-max-subject-size)))
|
||||
(save-excursion
|
||||
(if all
|
||||
(goto-char (point-min)))
|
||||
(while (re-search-forward mh-scan-subject-regexp nil t)
|
||||
(let ((this-subject (match-string-no-properties 3)))
|
||||
(if (> (length this-subject) mh-limit-max-subject-size)
|
||||
(setq this-subject (substring this-subject
|
||||
0 mh-limit-max-subject-size)))
|
||||
(if (string-equal this-subject subject)
|
||||
(setq list (cons (mh-get-msg-num t) list))))))
|
||||
(cond
|
||||
(list
|
||||
;; If we created a new sequence, add the initial message to it too.
|
||||
(if (not (member (mh-get-msg-num t) list))
|
||||
(setq list (cons (mh-get-msg-num t) list)))
|
||||
(if (assoc 'subject mh-seq-list) (mh-delete-seq 'subject))
|
||||
;; sort the result into a sequence
|
||||
(let ((sorted-list (sort (copy-sequence list) 'mh-lessp)))
|
||||
(while sorted-list
|
||||
(mh-add-msgs-to-seq (car sorted-list) 'subject nil)
|
||||
(setq sorted-list (cdr sorted-list)))
|
||||
(safe-length list)))
|
||||
(t
|
||||
0))))))
|
||||
|
||||
(defun mh-edit-pick-expr (default)
|
||||
"With prefix arg edit a pick expression.
|
||||
If no prefix arg is given, then return DEFAULT."
|
||||
(let ((default-string (loop for x in default concat (format " %s" x))))
|
||||
(if (or current-prefix-arg (equal default-string ""))
|
||||
(mh-pick-args-list (read-string "Pick expression: "
|
||||
default-string))
|
||||
default)))
|
||||
|
||||
(defun mh-pick-args-list (s)
|
||||
"Form list by grouping elements in string S suitable for pick arguments.
|
||||
For example, the string \"-subject a b c -from Joe User
|
||||
<user@domain.com>\" is converted to (\"-subject\" \"a b c\"
|
||||
\"-from\" \"Joe User <user@domain.com>\""
|
||||
(let ((full-list (split-string s))
|
||||
current-arg collection arg-list)
|
||||
(while full-list
|
||||
(setq current-arg (car full-list))
|
||||
(if (null (string-match "^-" current-arg))
|
||||
(setq collection
|
||||
(if (null collection)
|
||||
current-arg
|
||||
(format "%s %s" collection current-arg)))
|
||||
(when collection
|
||||
(setq arg-list (append arg-list (list collection)))
|
||||
(setq collection nil))
|
||||
(setq arg-list (append arg-list (list current-arg))))
|
||||
(setq full-list (cdr full-list)))
|
||||
(when collection
|
||||
(setq arg-list (append arg-list (list collection))))
|
||||
arg-list))
|
||||
|
||||
(defun mh-current-message-header-field (header-field)
|
||||
"Return a pick regexp to match HEADER-FIELD of the message at point."
|
||||
(let ((num (mh-get-msg-num nil)))
|
||||
(when num
|
||||
(let ((folder mh-current-folder))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents-literally (mh-msg-filename num folder))
|
||||
(goto-char (point-min))
|
||||
(when (search-forward "\n\n" nil t)
|
||||
(narrow-to-region (point-min) (point)))
|
||||
(let* ((field (or (message-fetch-field (format "%s" header-field))
|
||||
""))
|
||||
(field-option (format "-%s" header-field))
|
||||
(patterns (loop for x in (split-string field "[ ]*,[ ]*")
|
||||
unless (equal x "")
|
||||
collect (if (string-match "<\\(.*@.*\\)>" x)
|
||||
(match-string 1 x)
|
||||
x))))
|
||||
(when patterns
|
||||
(loop with accum = `(,field-option ,(car patterns))
|
||||
for e in (cdr patterns)
|
||||
do (setq accum `(,field-option ,e "-or" ,@accum))
|
||||
finally return accum))))))))
|
||||
|
||||
(defun mh-narrow-to-header-field (header-field pick-expr)
|
||||
"Limit to messages whose HEADER-FIELD match PICK-EXPR.
|
||||
The MH command pick is used to do the match."
|
||||
(let ((folder mh-current-folder)
|
||||
(original (mh-coalesce-msg-list
|
||||
(mh-range-to-msg-list (cons (point-min) (point-max)))))
|
||||
(msg-list ()))
|
||||
(with-temp-buffer
|
||||
(apply #'mh-exec-cmd-output "pick" nil folder
|
||||
(append original (list "-list") pick-expr))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(let ((num (ignore-errors
|
||||
(string-to-number
|
||||
(buffer-substring (point) (line-end-position))))))
|
||||
(when num (push num msg-list))
|
||||
(forward-line))))
|
||||
(if (null msg-list)
|
||||
(message "No matches")
|
||||
(when (assoc 'header mh-seq-list) (mh-delete-seq 'header))
|
||||
(mh-add-msgs-to-seq msg-list 'header)
|
||||
(mh-narrow-to-seq 'header))))
|
||||
|
||||
(provide 'mh-limit)
|
||||
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; sentence-end-double-space: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: b0d24378-1234-4c42-aa3f-7abad25b40a1
|
||||
;;; mh-limit.el ends here
|
||||
2553
lisp/mh-e/mh-mime.el
2553
lisp/mh-e/mh-mime.el
File diff suppressed because it is too large
Load diff
|
|
@ -30,15 +30,10 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
;;(message "> mh-print")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
(mh-require-cl)
|
||||
(require 'mh-e)
|
||||
(require 'mh-scan)
|
||||
|
||||
(require 'ps-print)
|
||||
(require 'mh-buffers)
|
||||
(require 'mh-utils)
|
||||
(require 'mh-funcs)
|
||||
(eval-when-compile (require 'mh-seq))
|
||||
;;(message "< mh-print")
|
||||
|
||||
(defvar mh-ps-print-color-option ps-print-color-p
|
||||
"Specify how buffer's text color is printed.
|
||||
|
|
@ -48,7 +43,7 @@ Valid values are:
|
|||
nil - Do not print colors.
|
||||
t - Print colors.
|
||||
black-white - Print colors on black/white printer.
|
||||
See also `ps-black-white-faces'.
|
||||
See also `ps-black-white-faces'.
|
||||
|
||||
Any other value is treated as t. This variable is initialized
|
||||
from `ps-print-color-p'.")
|
||||
|
|
@ -59,54 +54,6 @@ from `ps-print-color-p'.")
|
|||
Sensible choices are the functions `ps-spool-buffer' and
|
||||
`ps-spool-buffer-with-faces'.")
|
||||
|
||||
(defun mh-ps-spool-buffer (buffer)
|
||||
"Spool BUFFER."
|
||||
(save-excursion
|
||||
(set-buffer buffer)
|
||||
(let ((ps-print-color-p mh-ps-print-color-option)
|
||||
(ps-left-header
|
||||
(list
|
||||
(concat "(" (mh-get-header-field "Subject:") ")")
|
||||
(concat "(" (mh-get-header-field "From:") ")")))
|
||||
(ps-right-header
|
||||
(list
|
||||
"/pagenumberstring load"
|
||||
(concat "(" (mh-get-header-field "Date:") ")"))))
|
||||
(funcall mh-ps-print-func))))
|
||||
|
||||
(defun mh-ps-spool-msg (msg)
|
||||
"Spool MSG."
|
||||
(let* ((folder mh-current-folder)
|
||||
(buffer (mh-in-show-buffer (mh-show-buffer)
|
||||
(if (not (equal (mh-msg-filename msg folder)
|
||||
buffer-file-name))
|
||||
(get-buffer-create mh-temp-buffer)))))
|
||||
(unwind-protect
|
||||
(save-excursion
|
||||
(if buffer
|
||||
(let ((mh-show-buffer buffer))
|
||||
(mh-display-msg msg folder)))
|
||||
(mh-ps-spool-buffer (if buffer buffer mh-show-buffer)))
|
||||
(if buffer
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(defun mh-ps-print-range (range file)
|
||||
"Print RANGE to FILE.
|
||||
|
||||
This is the function that actually does the work.
|
||||
If FILE is nil, then the messages are spooled to the printer."
|
||||
(mh-iterate-on-range msg range
|
||||
(unwind-protect
|
||||
(mh-ps-spool-msg msg))
|
||||
(mh-notate msg mh-note-printed mh-cmd-note))
|
||||
(ps-despool file))
|
||||
|
||||
(defun mh-ps-print-preprint (prefix-arg)
|
||||
"Provide a better default file name for `ps-print-preprint'.
|
||||
Pass along the PREFIX-ARG to it."
|
||||
(let ((buffer-file-name (format "mh-%s" (substring (buffer-name) 1))))
|
||||
(ps-print-preprint prefix-arg)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-ps-print-msg (range)
|
||||
"Print RANGE\\<mh-folder-mode-map>.
|
||||
|
|
@ -130,6 +77,48 @@ commands \\[mh-ps-print-toggle-color] and
|
|||
(interactive (list (mh-interactive-range "Print")))
|
||||
(mh-ps-print-range range nil))
|
||||
|
||||
(defun mh-ps-print-range (range file)
|
||||
"Print RANGE to FILE.
|
||||
|
||||
This is the function that actually does the work.
|
||||
If FILE is nil, then the messages are spooled to the printer."
|
||||
(mh-iterate-on-range msg range
|
||||
(unwind-protect
|
||||
(mh-ps-spool-msg msg))
|
||||
(mh-notate msg mh-note-printed mh-cmd-note))
|
||||
(ps-despool file))
|
||||
|
||||
(defun mh-ps-spool-msg (msg)
|
||||
"Spool MSG."
|
||||
(let* ((folder mh-current-folder)
|
||||
(buffer (mh-in-show-buffer (mh-show-buffer)
|
||||
(if (not (equal (mh-msg-filename msg folder)
|
||||
buffer-file-name))
|
||||
(get-buffer-create mh-temp-buffer)))))
|
||||
(unwind-protect
|
||||
(save-excursion
|
||||
(if buffer
|
||||
(let ((mh-show-buffer buffer))
|
||||
(mh-display-msg msg folder)))
|
||||
(mh-ps-spool-buffer (if buffer buffer mh-show-buffer)))
|
||||
(if buffer
|
||||
(kill-buffer buffer)))))
|
||||
|
||||
(defun mh-ps-spool-buffer (buffer)
|
||||
"Spool BUFFER."
|
||||
(save-excursion
|
||||
(set-buffer buffer)
|
||||
(let ((ps-print-color-p mh-ps-print-color-option)
|
||||
(ps-left-header
|
||||
(list
|
||||
(concat "(" (mh-get-header-field "Subject:") ")")
|
||||
(concat "(" (mh-get-header-field "From:") ")")))
|
||||
(ps-right-header
|
||||
(list
|
||||
"/pagenumberstring load"
|
||||
(concat "(" (mh-get-header-field "Date:") ")"))))
|
||||
(funcall mh-ps-print-func))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-ps-print-msg-file (range file)
|
||||
"Print RANGE to FILE\\<mh-folder-mode-map>.
|
||||
|
|
@ -153,6 +142,12 @@ commands \\[mh-ps-print-toggle-color] and
|
|||
(interactive (list (mh-interactive-range "Print") (mh-ps-print-preprint 1)))
|
||||
(mh-ps-print-range range file))
|
||||
|
||||
(defun mh-ps-print-preprint (prefix-arg)
|
||||
"Provide a better default file name for `ps-print-preprint'.
|
||||
Pass along the PREFIX-ARG to it."
|
||||
(let ((buffer-file-name (format "mh-%s" (substring (buffer-name) 1))))
|
||||
(ps-print-preprint prefix-arg)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-ps-print-toggle-faces ()
|
||||
"Toggle whether printing is done with faces or not.
|
||||
|
|
@ -185,8 +180,8 @@ change this setting permanently by customizing the option
|
|||
(message "Colors will be printed as black & white"))
|
||||
(if (eq mh-ps-print-color-option 'black-white)
|
||||
(progn
|
||||
(setq mh-ps-print-color-option t)
|
||||
(message "Colors will be printed"))
|
||||
(setq mh-ps-print-color-option t)
|
||||
(message "Colors will be printed"))
|
||||
(setq mh-ps-print-color-option nil)
|
||||
(message "Colors will not be printed"))))
|
||||
|
||||
|
|
|
|||
491
lisp/mh-e/mh-scan.el
Normal file
491
lisp/mh-e/mh-scan.el
Normal file
|
|
@ -0,0 +1,491 @@
|
|||
;;; mh-scan.el --- MH-E scan line constants and utilities
|
||||
|
||||
;; Copyright (C) 1993, 1995, 1997,
|
||||
;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Bill Wohler <wohler@newt.com>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;; This file contains constants and a few functions for interpreting
|
||||
;; scan lines.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mh-e)
|
||||
|
||||
|
||||
|
||||
;;; Scan Formats
|
||||
|
||||
;; The following scan formats are passed to the scan program if the setting of
|
||||
;; `mh-scan-format-file' is t. They are identical except the later one makes
|
||||
;; use of the nmh `decode' function to decode RFC 2047 encodings. If you just
|
||||
;; want to change the column of the notations, use the `mh-set-cmd-note'
|
||||
;; function.
|
||||
|
||||
(defvar mh-scan-format-mh
|
||||
(concat
|
||||
"%4(msg)"
|
||||
"%<(cur)+%| %>"
|
||||
"%<{replied}-"
|
||||
"%?(nonnull(comp{to}))%<(mymbox{to})t%>"
|
||||
"%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
|
||||
"%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
|
||||
"%?(nonnull(comp{newsgroups}))n%>"
|
||||
"%<(zero) %>"
|
||||
"%02(mon{date})/%02(mday{date})%<{date} %|*%>"
|
||||
"%<(mymbox{from})%<{to}To:%14(friendly{to})%>%>"
|
||||
"%<(zero)%17(friendly{from})%> "
|
||||
"%{subject}%<{body}<<%{body}%>")
|
||||
"*Scan format string for MH.
|
||||
This string is passed to the scan program via the -format
|
||||
argument. This format is identical to the default except that
|
||||
additional hints for fontification have been added to the fifth
|
||||
column (remember that in Emacs, the first column is 0).
|
||||
|
||||
The values of the fifth column, in priority order, are: \"-\" if
|
||||
the message has been replied to, t if an address on the To: line
|
||||
matches one of the mailboxes of the current user, \"c\" if the Cc:
|
||||
line matches, \"b\" if the Bcc: line matches, and \"n\" if a
|
||||
non-empty Newsgroups: header is present.")
|
||||
|
||||
(defvar mh-scan-format-nmh
|
||||
(concat
|
||||
"%4(msg)"
|
||||
"%<(cur)+%| %>"
|
||||
"%<{replied}-"
|
||||
"%?(nonnull(comp{to}))%<(mymbox{to})t%>"
|
||||
"%?(nonnull(comp{cc}))%<(mymbox{cc})c%>"
|
||||
"%?(nonnull(comp{bcc}))%<(mymbox{bcc})b%>"
|
||||
"%?(nonnull(comp{newsgroups}))n%>"
|
||||
"%<(zero) %>"
|
||||
"%02(mon{date})/%02(mday{date})%<{date} %|*%>"
|
||||
"%<(mymbox{from})%<{to}To:%14(decode(friendly{to}))%>%>"
|
||||
"%<(zero)%17(decode(friendly{from}))%> "
|
||||
"%(decode{subject})%<{body}<<%{body}%>")
|
||||
"*Scan format string for nmh.
|
||||
This string is passed to the scan program via the -format arg.
|
||||
This format is identical to the default except that additional
|
||||
hints for fontification have been added to the fifth
|
||||
column (remember that in Emacs, the first column is 0).
|
||||
|
||||
The values of the fifth column, in priority order, are: \"-\" if
|
||||
the message has been replied to, t if an address on the To: field
|
||||
matches one of the mailboxes of the current user, \"c\" if the Cc:
|
||||
field matches, \"b\" if the Bcc: field matches, and \"n\" if a
|
||||
non-empty Newsgroups: field is present.")
|
||||
|
||||
|
||||
|
||||
;;; Regular Expressions
|
||||
|
||||
;; Alphabetical.
|
||||
|
||||
(defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)"
|
||||
"This regular expression matches the message body fragment.
|
||||
|
||||
Note that the default setting of `mh-folder-font-lock-keywords'
|
||||
expects this expression to contain at least one parenthesized
|
||||
expression which matches the body text as in the default of
|
||||
\"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\". If this regular expression is
|
||||
not correct, the body fragment will not be highlighted with the
|
||||
face `mh-folder-body'.")
|
||||
|
||||
(defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*"
|
||||
"This regular expression matches the current message.
|
||||
|
||||
It must match from the beginning of the line. Note that the
|
||||
default setting of `mh-folder-font-lock-keywords' expects this
|
||||
expression to contain at least one parenthesized expression which
|
||||
matches the message number as in the default of
|
||||
|
||||
\"^\\\\( *[0-9]+\\\\+\\\\).*\".
|
||||
|
||||
This expression includes the leading space and current message
|
||||
marker \"+\" within the parenthesis since it looks better to
|
||||
highlight these items as well. The highlighting is done with the
|
||||
face `mh-folder-cur-msg-number'. This regular expression should
|
||||
be correct as it is needed by non-fontification functions. See
|
||||
also `mh-note-cur'.")
|
||||
|
||||
(defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)"
|
||||
"This regular expression matches a valid date.
|
||||
|
||||
It must not be anchored to the beginning or the end of the line.
|
||||
Note that the default setting of `mh-folder-font-lock-keywords'
|
||||
expects this expression to contain only one parenthesized
|
||||
expression which matches the date field as in the default of
|
||||
\"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}. If this regular expression
|
||||
is not correct, the date will not be highlighted with the face
|
||||
`mh-folder-date'.")
|
||||
|
||||
(defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D"
|
||||
"This regular expression matches deleted messages.
|
||||
|
||||
It must match from the beginning of the line. Note that the
|
||||
default setting of `mh-folder-font-lock-keywords' expects this
|
||||
expression to contain at least one parenthesized expression which
|
||||
matches the message number as in the default of
|
||||
|
||||
\"^\\\\( *[0-9]+\\\\)D\".
|
||||
|
||||
This expression includes the leading space within the parenthesis
|
||||
since it looks better to highlight it as well. The highlighting
|
||||
is done with the face `mh-folder-deleted'. This regular
|
||||
expression should be correct as it is needed by non-fontification
|
||||
functions. See also `mh-note-deleted'.")
|
||||
|
||||
(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]"
|
||||
"This regular expression matches \"good\" messages.
|
||||
|
||||
It must match from the beginning of the line. Note that the
|
||||
default setting of `mh-folder-font-lock-keywords' expects this
|
||||
expression to contain at least one parenthesized expression which
|
||||
matches the message number as in the default of
|
||||
|
||||
\"^\\\\( *[0-9]+\\\\)[^D^0-9]\".
|
||||
|
||||
This expression includes the leading space within the parenthesis
|
||||
since it looks better to highlight it as well. The highlighting
|
||||
is done with the face `mh-folder-msg-number'. This regular
|
||||
expression should be correct as it is needed by non-fontification
|
||||
functions.")
|
||||
|
||||
(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
|
||||
"This regular expression finds the message number width in a scan format.
|
||||
|
||||
Note that the message number must be placed in a parenthesized
|
||||
expression as in the default of \"%\\\\([0-9]*\\\\)(msg)\". This
|
||||
variable is only consulted if `mh-scan-format-file' is set to
|
||||
\"Use MH-E scan Format\".")
|
||||
|
||||
(defvar mh-scan-msg-format-string "%d"
|
||||
"This is a format string for width of the message number in a scan format.
|
||||
|
||||
Use \"0%d\" for zero-filled message numbers. This variable is only
|
||||
consulted if `mh-scan-format-file' is set to \"Use MH-E scan
|
||||
Format\".")
|
||||
|
||||
(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
|
||||
"This regular expression extracts the message number.
|
||||
|
||||
It must match from the beginning of the line. Note that the
|
||||
message number must be placed in a parenthesized expression as in
|
||||
the default of \"^ *\\\\([0-9]+\\\\)\".")
|
||||
|
||||
(defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]"
|
||||
"This regular expression matches overflowed message numbers.")
|
||||
|
||||
(defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]"
|
||||
"This regular expression matches a particular message.
|
||||
|
||||
It is a format string; use \"%d\" to represent the location of the
|
||||
message number within the expression as in the default of
|
||||
\"^[^0-9]*%d[^0-9]\".")
|
||||
|
||||
(defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)"
|
||||
"This regular expression specifies the recipient in messages you sent.
|
||||
|
||||
Note that the default setting of `mh-folder-font-lock-keywords'
|
||||
expects this expression to contain two parenthesized expressions.
|
||||
The first is expected to match the \"To:\" that the default scan
|
||||
format file generates. The second is expected to match the
|
||||
recipient's name as in the default of
|
||||
\"\\\\(To:\\\\)\\\\(..............\\\\)\". If this regular
|
||||
expression is not correct, the \"To:\" string will not be
|
||||
highlighted with the face `mh-folder-to' and the recipient will
|
||||
not be highlighted with the face `mh-folder-address'")
|
||||
|
||||
(defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^"
|
||||
"This regular expression matches refiled messages.
|
||||
|
||||
It must match from the beginning of the line. Note that the
|
||||
default setting of `mh-folder-font-lock-keywords' expects this
|
||||
expression to contain at least one parenthesized expression which
|
||||
matches the message number as in the default of
|
||||
|
||||
\"^\\\\( *[0-9]+\\\\)\\\\^\".
|
||||
|
||||
This expression includes the leading space within the parenthesis
|
||||
since it looks better to highlight it as well. The highlighting
|
||||
is done with the face `mh-folder-refiled'. This regular
|
||||
expression should be correct as it is needed by non-fontification
|
||||
functions. See also `mh-note-refiled'.")
|
||||
|
||||
(defvar mh-scan-sent-to-me-sender-regexp
|
||||
"^ *[0-9]+.\\([bct]\\).....[ ]*\\(..................\\)"
|
||||
"This regular expression matches messages sent to us.
|
||||
|
||||
Note that the default setting of `mh-folder-font-lock-keywords'
|
||||
expects this expression to contain at least two parenthesized
|
||||
expressions. The first should match the fontification hint (see
|
||||
`mh-scan-format-nmh') and the second should match the user name
|
||||
as in the default of
|
||||
|
||||
^ *[0-9]+.\\\\([bct]\\\\).....[ ]*\\\\(..................\\\\)
|
||||
|
||||
If this regular expression is not correct, the notation hints
|
||||
will not be highlighted with the face
|
||||
`mh-mh-folder-sent-to-me-hint' and the sender will not be
|
||||
highlighted with the face `mh-folder-sent-to-me-sender'.")
|
||||
|
||||
(defvar mh-scan-subject-regexp
|
||||
"^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
|
||||
"This regular expression matches the subject.
|
||||
|
||||
It must match from the beginning of the line. Note that the
|
||||
default setting of `mh-folder-font-lock-keywords' expects this
|
||||
expression to contain at least three parenthesized expressions.
|
||||
The first is expected to match the \"Re:\" string, if any, and is
|
||||
highlighted with the face `mh-folder-followup'. The second
|
||||
matches an optional bracketed number after \"Re:\", such as in
|
||||
\"Re[2]:\" (and is thus a sub-expression of the first expression)
|
||||
and the third is expected to match the subject line itself which
|
||||
is highlighted with the face `mh-folder-subject'. For example,
|
||||
the default (broken on multiple lines for readability) is
|
||||
|
||||
^ *[0-9]+........[ ]*...................
|
||||
\\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)*
|
||||
\\\\([^<\\n]*\\\\)
|
||||
|
||||
This regular expression should be correct as it is needed by
|
||||
non-fontification functions.")
|
||||
|
||||
(defvar mh-scan-valid-regexp "^ *[0-9]"
|
||||
"This regular expression describes a valid scan line.
|
||||
|
||||
This is used to eliminate error messages that are occasionally
|
||||
produced by \"inc\".")
|
||||
|
||||
|
||||
|
||||
;;; Widths, Offsets and Columns
|
||||
|
||||
(defvar mh-cmd-note 4
|
||||
"Column for notations.
|
||||
|
||||
This variable should be set with the function `mh-set-cmd-note'.
|
||||
This variable may be updated dynamically if
|
||||
`mh-adaptive-cmd-note-flag' is on.
|
||||
|
||||
Note that columns in Emacs start with 0.")
|
||||
(make-variable-buffer-local 'mh-cmd-note)
|
||||
|
||||
(defvar mh-scan-cmd-note-width 1
|
||||
"Number of columns consumed by the cmd-note field in `mh-scan-format'.
|
||||
|
||||
This column will have one of the values: \" \", \"D\", \"^\", \"+\" and
|
||||
where \" \" is the default value,
|
||||
|
||||
\"D\" is the `mh-note-deleted' character,
|
||||
\"^\" is the `mh-note-refiled' character, and
|
||||
\"+\" is the `mh-note-cur' character.")
|
||||
|
||||
(defvar mh-scan-destination-width 1
|
||||
"Number of columns consumed by the destination field in `mh-scan-format'.
|
||||
|
||||
This column will have one of \" \", \"%\", \"-\", \"t\", \"c\", \"b\", or \"n\"
|
||||
in it.
|
||||
|
||||
\" \" blank space is the default character.
|
||||
\"%\" indicates that the message in in a named MH sequence.
|
||||
\"-\" indicates that the message has been annotated with a replied field.
|
||||
\"t\" indicates that the message contains mymbox in the To: field.
|
||||
\"c\" indicates that the message contains mymbox in the Cc: field.
|
||||
\"b\" indicates that the message contains mymbox in the Bcc: field.
|
||||
\"n\" indicates that the message contains a Newsgroups: field.")
|
||||
|
||||
(defvar mh-scan-date-width 5
|
||||
"Number of columns consumed by the date field in `mh-scan-format'.
|
||||
This column will typically be of the form mm/dd.")
|
||||
|
||||
(defvar mh-scan-date-flag-width 1
|
||||
"Number of columns consumed to flag (in)valid dates in `mh-scan-format'.
|
||||
This column will have \" \" for valid and \"*\" for invalid or
|
||||
missing dates.")
|
||||
|
||||
(defvar mh-scan-from-mbox-width 17
|
||||
"Number of columns consumed with the \"From:\" line in `mh-scan-format'.
|
||||
This column will have a friendly name or e-mail address of the
|
||||
originator, or a \"To: address\" for outgoing e-mail messages.")
|
||||
|
||||
(defvar mh-scan-from-mbox-sep-width 2
|
||||
"Number of columns consumed by whitespace after from-mbox in `mh-scan-format'.
|
||||
This column will only ever have spaces in it.")
|
||||
|
||||
(defvar mh-scan-field-destination-offset
|
||||
(+ mh-scan-cmd-note-width)
|
||||
"The offset from the `mh-cmd-note' for the destination column.")
|
||||
|
||||
(defvar mh-scan-field-from-start-offset
|
||||
(+ mh-scan-cmd-note-width
|
||||
mh-scan-destination-width
|
||||
mh-scan-date-width
|
||||
mh-scan-date-flag-width)
|
||||
"The offset from the `mh-cmd-note' to find the start of \"From:\" address.")
|
||||
|
||||
(defvar mh-scan-field-from-end-offset
|
||||
(+ mh-scan-field-from-start-offset mh-scan-from-mbox-width)
|
||||
"The offset from the `mh-cmd-note' to find the end of \"From:\" address.")
|
||||
|
||||
(defvar mh-scan-field-subject-start-offset
|
||||
(+ mh-scan-cmd-note-width
|
||||
mh-scan-destination-width
|
||||
mh-scan-date-width
|
||||
mh-scan-date-flag-width
|
||||
mh-scan-from-mbox-width
|
||||
mh-scan-from-mbox-sep-width)
|
||||
"The offset from the `mh-cmd-note' to find the start of the subject.")
|
||||
|
||||
|
||||
|
||||
;;; Notation
|
||||
|
||||
;; Alphabetical.
|
||||
|
||||
(defvar mh-note-cur ?+
|
||||
"The current message (in MH, not in MH-E) is marked by this character.
|
||||
See also `mh-scan-cur-msg-number-regexp'.")
|
||||
|
||||
(defvar mh-note-copied ?C
|
||||
"Messages that have been copied are marked by this character.")
|
||||
|
||||
(defvar mh-note-deleted ?D
|
||||
"Messages that have been deleted are marked by this character.
|
||||
See also `mh-scan-deleted-msg-regexp'.")
|
||||
|
||||
(defvar mh-note-dist ?R
|
||||
"Messages that have been redistributed are marked by this character.")
|
||||
|
||||
(defvar mh-note-forw ?F
|
||||
"Messages that have been forwarded are marked by this character.")
|
||||
|
||||
(defvar mh-note-printed ?P
|
||||
"Messages that have been printed are marked by this character.")
|
||||
|
||||
(defvar mh-note-refiled ?^
|
||||
"Messages that have been refiled are marked by this character.
|
||||
See also `mh-scan-refiled-msg-regexp'.")
|
||||
|
||||
(defvar mh-note-repl ?-
|
||||
"Messages that have been replied to are marked by this character.")
|
||||
|
||||
(defvar mh-note-seq ?%
|
||||
"Messages in a user-defined sequence are marked by this character.
|
||||
|
||||
Messages in the \"search\" sequence are marked by this character as
|
||||
well.")
|
||||
|
||||
|
||||
|
||||
;;; Utilities
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-scan-msg-number-regexp ()
|
||||
"Return value of variable `mh-scan-msg-number-regexp'."
|
||||
mh-scan-msg-number-regexp)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-scan-msg-search-regexp ()
|
||||
"Return value of variable `mh-scan-msg-search-regexp'."
|
||||
mh-scan-msg-search-regexp)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-set-cmd-note (column)
|
||||
"Set `mh-cmd-note' to COLUMN.
|
||||
Note that columns in Emacs start with 0."
|
||||
(setq mh-cmd-note column))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-scan-format ()
|
||||
"Return the output format argument for the scan program."
|
||||
(if (equal mh-scan-format-file t)
|
||||
(list "-format" (if (mh-variant-p 'nmh 'mu-mh)
|
||||
(list (mh-update-scan-format
|
||||
mh-scan-format-nmh mh-cmd-note))
|
||||
(list (mh-update-scan-format
|
||||
mh-scan-format-mh mh-cmd-note))))
|
||||
(if (not (equal mh-scan-format-file nil))
|
||||
(list "-form" mh-scan-format-file))))
|
||||
|
||||
(defun mh-update-scan-format (fmt width)
|
||||
"Return a scan format with the (msg) width in the FMT replaced with WIDTH.
|
||||
|
||||
The message number width portion of the format is discovered
|
||||
using `mh-scan-msg-format-regexp'. Its replacement is controlled
|
||||
with `mh-scan-msg-format-string'."
|
||||
(or (and
|
||||
(string-match mh-scan-msg-format-regexp fmt)
|
||||
(let ((begin (match-beginning 1))
|
||||
(end (match-end 1)))
|
||||
(concat (substring fmt 0 begin)
|
||||
(format mh-scan-msg-format-string width)
|
||||
(substring fmt end))))
|
||||
fmt))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-msg-num-width (folder)
|
||||
"Return the width of the largest message number in this FOLDER."
|
||||
(or mh-progs (mh-find-path))
|
||||
(let ((tmp-buffer (get-buffer-create mh-temp-buffer))
|
||||
(width 0))
|
||||
(save-excursion
|
||||
(set-buffer tmp-buffer)
|
||||
(erase-buffer)
|
||||
(apply 'call-process
|
||||
(expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
|
||||
(list folder "last" "-format" "%(msg)"))
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward mh-scan-msg-number-regexp nil 0 1)
|
||||
(setq width (length (buffer-substring
|
||||
(match-beginning 1) (match-end 1))))))
|
||||
width))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-msg-num-width-to-column (width)
|
||||
"Return the column for notations given message number WIDTH.
|
||||
Note that columns in Emacs start with 0.
|
||||
|
||||
If `mh-scan-format-file' is set to \"Use MH-E scan Format\" this
|
||||
means that either `mh-scan-format-mh' or `mh-scan-format-nmh' are
|
||||
in use. This function therefore assumes that the first column is
|
||||
empty (to provide room for the cursor), the following WIDTH
|
||||
columns contain the message number, and the column for notations
|
||||
comes after that."
|
||||
(if (eq mh-scan-format-file t)
|
||||
(max (1+ width) 2)
|
||||
(error "%s %s" "Can't call `mh-msg-num-width-to-column' when"
|
||||
"`mh-scan-format-file' is not set to \"Use MH-E scan Format\"")))
|
||||
|
||||
(provide 'mh-scan)
|
||||
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; sentence-end-double-space: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 5ab35d46-101e-443b-a2b6-5a908cf97528
|
||||
;;; mh-scan.el ends here
|
||||
|
|
@ -1,4 +1,4 @@
|
|||
;;; mh-search --- MH-E search
|
||||
;;; mh-search --- MH-Search mode
|
||||
|
||||
;; Copyright (C) 1993, 1995,
|
||||
;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
|
@ -27,6 +27,8 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; Mode used to compose search criteria.
|
||||
|
||||
;; (1) The following search engines are supported:
|
||||
;; swish++
|
||||
;; swish-e
|
||||
|
|
@ -34,7 +36,7 @@
|
|||
;; namazu
|
||||
;; pick
|
||||
;; grep
|
||||
;;
|
||||
|
||||
;; (2) To use this package, you first have to build an index. Please
|
||||
;; read the documentation for `mh-search' to get started. That
|
||||
;; documentation will direct you to the specific instructions for
|
||||
|
|
@ -44,14 +46,12 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
;;(message "> mh-search")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
(require 'mh-e)
|
||||
(mh-require-cl)
|
||||
|
||||
(require 'gnus-util)
|
||||
(require 'mh-buffers)
|
||||
(require 'mh-e)
|
||||
;;(message "< mh-search")
|
||||
(require 'imenu)
|
||||
(require 'which-func nil t)
|
||||
|
||||
(defvar mh-searcher nil
|
||||
"Cached value of chosen search program.")
|
||||
|
|
@ -79,7 +79,7 @@ message number, and optionally the match.")
|
|||
|
||||
|
||||
|
||||
;;; MH-Search mode
|
||||
;;; MH-Folder Commands
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun* mh-search (folder search-regexp
|
||||
|
|
@ -322,6 +322,9 @@ folder containing the index search results."
|
|||
(loop for msg-hash being hash-values of mh-index-data
|
||||
count (> (hash-table-count msg-hash) 0))))))
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile (mh-do-in-xemacs (defvar pick-folder)))
|
||||
|
||||
(defun mh-search-folder (folder window-config)
|
||||
"Search FOLDER for messages matching a pattern.
|
||||
|
||||
|
|
@ -363,30 +366,182 @@ configuration and is used when the search folder is dismissed."
|
|||
(add-text-properties (point) (1- (line-end-position)) '(read-only t))
|
||||
(goto-char (point-max)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defvar mh-search-mode-map (make-sparse-keymap)
|
||||
"Keymap for searching folder.")
|
||||
;; Sequence Searches
|
||||
|
||||
;;;###mh-autoload
|
||||
;; If this changes, modify mh-search-mode-help-messages accordingly, below.
|
||||
(gnus-define-keys mh-search-mode-map
|
||||
"\C-c?" mh-help
|
||||
"\C-c\C-c" mh-index-do-search
|
||||
"\C-c\C-p" mh-pick-do-search
|
||||
"\C-c\C-f\C-b" mh-to-field
|
||||
"\C-c\C-f\C-c" mh-to-field
|
||||
"\C-c\C-f\C-d" mh-to-field
|
||||
"\C-c\C-f\C-f" mh-to-field
|
||||
"\C-c\C-f\C-r" mh-to-field
|
||||
"\C-c\C-f\C-s" mh-to-field
|
||||
"\C-c\C-f\C-t" mh-to-field
|
||||
"\C-c\C-fb" mh-to-field
|
||||
"\C-c\C-fc" mh-to-field
|
||||
"\C-c\C-fd" mh-to-field
|
||||
"\C-c\C-ff" mh-to-field
|
||||
"\C-c\C-fr" mh-to-field
|
||||
"\C-c\C-fs" mh-to-field
|
||||
"\C-c\C-ft" mh-to-field)
|
||||
(defun mh-index-new-messages (folders)
|
||||
"Display unseen messages.
|
||||
|
||||
If you use a program such as \"procmail\" to use \"rcvstore\" to file
|
||||
your incoming mail automatically, you can display new, unseen,
|
||||
messages using this command. All messages in the \"unseen\"
|
||||
sequence from the folders in `mh-new-messages-folders' are
|
||||
listed.
|
||||
|
||||
With a prefix argument, enter a space-separated list of FOLDERS,
|
||||
or nothing to search all folders."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
(split-string (read-string "Search folder(s) (default all): "))
|
||||
mh-new-messages-folders)))
|
||||
(mh-index-sequenced-messages folders mh-unseen-seq))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-ticked-messages (folders)
|
||||
"Display ticked messages.
|
||||
|
||||
All messages in `mh-tick-seq' from the folders in
|
||||
`mh-ticked-messages-folders' are listed.
|
||||
|
||||
With a prefix argument, enter a space-separated list of FOLDERS,
|
||||
or nothing to search all folders."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
(split-string (read-string "Search folder(s) (default all): "))
|
||||
mh-ticked-messages-folders)))
|
||||
(mh-index-sequenced-messages folders mh-tick-seq))
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile
|
||||
(mh-do-in-xemacs
|
||||
(defvar mh-mairix-folder)
|
||||
(defvar mh-flists-search-folders)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-sequenced-messages (folders sequence)
|
||||
"Display messages in any sequence.
|
||||
|
||||
All messages from the FOLDERS in `mh-new-messages-folders' in the
|
||||
SEQUENCE you provide are listed. With a prefix argument, enter a
|
||||
space-separated list of folders at the prompt, or nothing to
|
||||
search all folders."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
(split-string (read-string "Search folder(s) (default all): "))
|
||||
mh-new-messages-folders)
|
||||
(mh-read-seq-default "Search" nil)))
|
||||
(unless sequence (setq sequence mh-unseen-seq))
|
||||
(let* ((mh-flists-search-folders folders)
|
||||
(mh-flists-sequence sequence)
|
||||
(mh-flists-called-flag t)
|
||||
(mh-searcher 'flists)
|
||||
(mh-search-function 'mh-flists-execute)
|
||||
(mh-search-next-result-function 'mh-mairix-next-result)
|
||||
(mh-mairix-folder mh-user-path)
|
||||
(mh-search-regexp-builder nil)
|
||||
(new-folder (format "%s/%s/%s" mh-index-folder
|
||||
mh-flists-results-folder sequence))
|
||||
(window-config (if (equal new-folder mh-current-folder)
|
||||
mh-previous-window-config
|
||||
(current-window-configuration)))
|
||||
(redo-flag nil)
|
||||
message)
|
||||
(cond ((buffer-live-p (get-buffer new-folder))
|
||||
;; The destination folder is being visited. Trick `mh-search'
|
||||
;; into thinking that the folder resulted from a previous search.
|
||||
(set-buffer new-folder)
|
||||
(setq mh-index-previous-search (list folders mh-searcher sequence))
|
||||
(setq redo-flag t))
|
||||
((mh-folder-exists-p new-folder)
|
||||
;; Folder exists but we don't have it open. That means they are
|
||||
;; stale results from a old flists search. Clear it out.
|
||||
(mh-exec-cmd-quiet nil "rmf" new-folder)))
|
||||
(setq message (mh-search "+" mh-flists-results-folder
|
||||
redo-flag window-config)
|
||||
mh-index-sequence-search-flag t
|
||||
mh-index-previous-search (list folders mh-searcher sequence))
|
||||
(mh-index-write-data)
|
||||
(when (stringp message) (message "%s" message))))
|
||||
|
||||
(defvar mh-flists-search-folders)
|
||||
|
||||
(defun mh-flists-execute (&rest args)
|
||||
"Execute flists.
|
||||
Search for messages belonging to `mh-flists-sequence' in the
|
||||
folders specified by `mh-flists-search-folders'. If
|
||||
`mh-recursive-folders-flag' is t, then the folders are searched
|
||||
recursively. All parameters ARGS are ignored."
|
||||
(set-buffer (get-buffer-create mh-temp-index-buffer))
|
||||
(erase-buffer)
|
||||
(unless (executable-find "sh")
|
||||
(error "Didn't find sh"))
|
||||
(with-temp-buffer
|
||||
(let ((seq (symbol-name mh-flists-sequence)))
|
||||
(insert "for folder in `" (expand-file-name "flists" mh-progs) " "
|
||||
(cond ((eq mh-flists-search-folders t)
|
||||
(mh-quote-for-shell mh-inbox))
|
||||
((eq mh-flists-search-folders nil) "")
|
||||
((listp mh-flists-search-folders)
|
||||
(loop for folder in mh-flists-search-folders
|
||||
concat
|
||||
(concat " " (mh-quote-for-shell folder)))))
|
||||
(if mh-recursive-folders-flag " -recurse" "")
|
||||
" -sequence " seq " -noshowzero -fast` ; do\n"
|
||||
(expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n"
|
||||
"done\n"))
|
||||
(call-process-region
|
||||
(point-min) (point-max) "sh" nil (get-buffer mh-temp-index-buffer))))
|
||||
|
||||
;; Navigation
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-next-folder (&optional backward-flag)
|
||||
"Jump to the next folder marker.
|
||||
|
||||
With non-nil optional argument BACKWARD-FLAG, jump to the previous
|
||||
group of results."
|
||||
(interactive "P")
|
||||
(if (null mh-index-data)
|
||||
(message "Only applicable in an MH-E index search buffer")
|
||||
(let ((point (point)))
|
||||
(forward-line (if backward-flag 0 1))
|
||||
(cond ((if backward-flag
|
||||
(re-search-backward "^+" (point-min) t)
|
||||
(re-search-forward "^+" (point-max) t))
|
||||
(beginning-of-line))
|
||||
((and (if backward-flag
|
||||
(goto-char (point-max))
|
||||
(goto-char (point-min)))
|
||||
nil))
|
||||
((if backward-flag
|
||||
(re-search-backward "^+" (point-min) t)
|
||||
(re-search-forward "^+" (point-max) t))
|
||||
(beginning-of-line))
|
||||
(t (goto-char point))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-previous-folder ()
|
||||
"Jump to the previous folder marker."
|
||||
(interactive)
|
||||
(mh-index-next-folder t))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-visit-folder ()
|
||||
"Visit original folder from where the message at point was found."
|
||||
(interactive)
|
||||
(unless mh-index-data
|
||||
(error "Not in an index folder"))
|
||||
(let (folder msg)
|
||||
(save-excursion
|
||||
(cond ((and (bolp) (eolp))
|
||||
(ignore-errors (forward-line -1))
|
||||
(setq msg (mh-get-msg-num t)))
|
||||
((equal (char-after (line-beginning-position)) ?+)
|
||||
(setq folder (buffer-substring-no-properties
|
||||
(line-beginning-position) (line-end-position))))
|
||||
(t (setq msg (mh-get-msg-num t)))))
|
||||
(when (not folder)
|
||||
(setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
|
||||
mh-index-checksum-origin-map))))
|
||||
(when (or (not (get-buffer folder))
|
||||
(y-or-n-p (format "Reuse buffer displaying %s? " folder)))
|
||||
(mh-visit-folder
|
||||
folder (loop for x being the hash-keys of (gethash folder mh-index-data)
|
||||
when (mh-msg-exists-p x folder) collect x)))))
|
||||
|
||||
|
||||
|
||||
;;; Search Menu
|
||||
|
||||
(easy-menu-define
|
||||
mh-pick-menu mh-search-mode-map "Menu for MH-E Search"
|
||||
|
|
@ -394,11 +549,35 @@ configuration and is used when the search folder is dismissed."
|
|||
["Perform Search" mh-index-do-search t]
|
||||
["Search with pick" mh-pick-do-search t]))
|
||||
|
||||
|
||||
|
||||
;;; MH-Search Keys
|
||||
|
||||
;; If this changes, modify mh-search-mode-help-messages accordingly, below.
|
||||
(gnus-define-keys mh-search-mode-map
|
||||
"\C-c?" mh-help
|
||||
"\C-c\C-c" mh-index-do-search
|
||||
"\C-c\C-p" mh-pick-do-search
|
||||
"\C-c\C-f\C-b" mh-to-field
|
||||
"\C-c\C-f\C-c" mh-to-field
|
||||
"\C-c\C-f\C-m" mh-to-field
|
||||
"\C-c\C-f\C-s" mh-to-field
|
||||
"\C-c\C-f\C-t" mh-to-field
|
||||
"\C-c\C-fb" mh-to-field
|
||||
"\C-c\C-fc" mh-to-field
|
||||
"\C-c\C-fm" mh-to-field
|
||||
"\C-c\C-fs" mh-to-field
|
||||
"\C-c\C-ft" mh-to-field)
|
||||
|
||||
|
||||
|
||||
;;; MH-Search Help Messages
|
||||
|
||||
;; Group messages logically, more or less.
|
||||
(defvar mh-search-mode-help-messages
|
||||
'((nil
|
||||
"Perform search: \\[mh-index-do-search]\n"
|
||||
"Search with pick: \\[mh-pick-do-search]\n"
|
||||
"Perform search: \\[mh-index-do-search]\n"
|
||||
"Search with pick: \\[mh-pick-do-search]\n\n"
|
||||
"Move to a field by typing C-c C-f C-<field>\n"
|
||||
"where <field> is the first letter of the desired field\n"
|
||||
"(except for From: which uses \"m\")."))
|
||||
|
|
@ -413,6 +592,10 @@ display the non-prefixed commands.
|
|||
The substitutions described in `substitute-command-keys' are performed
|
||||
as well.")
|
||||
|
||||
|
||||
|
||||
;;; MH-Search Mode
|
||||
|
||||
(put 'mh-search-mode 'mode-class 'special)
|
||||
|
||||
(define-derived-mode mh-search-mode fundamental-mode "MH-Search"
|
||||
|
|
@ -435,11 +618,13 @@ The hook `mh-search-mode-hook' is called upon entry to this mode.
|
|||
|
||||
\\{mh-search-mode-map}"
|
||||
|
||||
(make-local-variable 'mh-help-messages)
|
||||
(easy-menu-add mh-pick-menu)
|
||||
(setq mh-help-messages mh-search-mode-help-messages))
|
||||
(mh-set-help mh-search-mode-help-messages))
|
||||
|
||||
|
||||
|
||||
;;; MH-Search Commands
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-do-search (&optional searcher)
|
||||
"Find messages using `mh-search-program'.
|
||||
If optional argument SEARCHER is present, use it instead of
|
||||
|
|
@ -452,7 +637,6 @@ If optional argument SEARCHER is present, use it instead of
|
|||
(mh-search mh-current-folder pattern nil mh-previous-window-config)
|
||||
(error "No search terms"))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-pick-do-search ()
|
||||
"Find messages using \"pick\".
|
||||
|
||||
|
|
@ -490,7 +674,6 @@ The cdr of the element is the pattern to search."
|
|||
(forward-line))
|
||||
pattern-list)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-parse-search-regexp (input-string)
|
||||
"Construct parse tree for INPUT-STRING.
|
||||
All occurrences of &, |, ! and ~ in INPUT-STRING are replaced by
|
||||
|
|
@ -594,296 +777,7 @@ parsed."
|
|||
|
||||
|
||||
|
||||
;;; Sequence browsing
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-new-messages (folders)
|
||||
"Display unseen messages.
|
||||
|
||||
If you use a program such as \"procmail\" to use \"rcvstore\" to file
|
||||
your incoming mail automatically, you can display new, unseen,
|
||||
messages using this command. All messages in the \"unseen\"
|
||||
sequence from the folders in `mh-new-messages-folders' are
|
||||
listed.
|
||||
|
||||
With a prefix argument, enter a space-separated list of FOLDERS,
|
||||
or nothing to search all folders."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
(split-string (read-string "Search folder(s) (default all): "))
|
||||
mh-new-messages-folders)))
|
||||
(mh-index-sequenced-messages folders mh-unseen-seq))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-ticked-messages (folders)
|
||||
"Display ticked messages.
|
||||
|
||||
All messages in `mh-tick-seq' from the folders in
|
||||
`mh-ticked-messages-folders' are listed.
|
||||
|
||||
With a prefix argument, enter a space-separated list of FOLDERS,
|
||||
or nothing to search all folders."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
(split-string (read-string "Search folder(s) (default all): "))
|
||||
mh-ticked-messages-folders)))
|
||||
(mh-index-sequenced-messages folders mh-tick-seq))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-sequenced-messages (folders sequence)
|
||||
"Display messages in any sequence.
|
||||
|
||||
All messages from the FOLDERS in `mh-new-messages-folders' in the
|
||||
SEQUENCE you provide are listed. With a prefix argument, enter a
|
||||
space-separated list of folders at the prompt, or nothing to
|
||||
search all folders."
|
||||
(interactive
|
||||
(list (if current-prefix-arg
|
||||
(split-string (read-string "Search folder(s) (default all): "))
|
||||
mh-new-messages-folders)
|
||||
(mh-read-seq-default "Search" nil)))
|
||||
(unless sequence (setq sequence mh-unseen-seq))
|
||||
(let* ((mh-flists-search-folders folders)
|
||||
(mh-flists-sequence sequence)
|
||||
(mh-flists-called-flag t)
|
||||
(mh-searcher 'flists)
|
||||
(mh-search-function 'mh-flists-execute)
|
||||
(mh-search-next-result-function 'mh-mairix-next-result)
|
||||
(mh-mairix-folder mh-user-path)
|
||||
(mh-search-regexp-builder nil)
|
||||
(new-folder (format "%s/%s/%s" mh-index-folder
|
||||
mh-flists-results-folder sequence))
|
||||
(window-config (if (equal new-folder mh-current-folder)
|
||||
mh-previous-window-config
|
||||
(current-window-configuration)))
|
||||
(redo-flag nil)
|
||||
message)
|
||||
(cond ((buffer-live-p (get-buffer new-folder))
|
||||
;; The destination folder is being visited. Trick `mh-search'
|
||||
;; into thinking that the folder resulted from a previous search.
|
||||
(set-buffer new-folder)
|
||||
(setq mh-index-previous-search (list folders mh-searcher sequence))
|
||||
(setq redo-flag t))
|
||||
((mh-folder-exists-p new-folder)
|
||||
;; Folder exists but we don't have it open. That means they are
|
||||
;; stale results from a old flists search. Clear it out.
|
||||
(mh-exec-cmd-quiet nil "rmf" new-folder)))
|
||||
(setq message (mh-search "+" mh-flists-results-folder
|
||||
redo-flag window-config)
|
||||
mh-index-sequence-search-flag t
|
||||
mh-index-previous-search (list folders mh-searcher sequence))
|
||||
(mh-index-write-data)
|
||||
(when (stringp message) (message "%s" message))))
|
||||
|
||||
(defvar mh-flists-search-folders)
|
||||
|
||||
(defun mh-flists-execute (&rest args)
|
||||
"Execute flists.
|
||||
Search for messages belonging to `mh-flists-sequence' in the
|
||||
folders specified by `mh-flists-search-folders'. If
|
||||
`mh-recursive-folders-flag' is t, then the folders are searched
|
||||
recursively. All parameters ARGS are ignored."
|
||||
(set-buffer (get-buffer-create mh-temp-index-buffer))
|
||||
(erase-buffer)
|
||||
(unless (executable-find "sh")
|
||||
(error "Didn't find sh"))
|
||||
(with-temp-buffer
|
||||
(let ((seq (symbol-name mh-flists-sequence)))
|
||||
(insert "for folder in `" (expand-file-name "flists" mh-progs) " "
|
||||
(cond ((eq mh-flists-search-folders t)
|
||||
(mh-quote-for-shell mh-inbox))
|
||||
((eq mh-flists-search-folders nil) "")
|
||||
((listp mh-flists-search-folders)
|
||||
(loop for folder in mh-flists-search-folders
|
||||
concat
|
||||
(concat " " (mh-quote-for-shell folder)))))
|
||||
(if mh-recursive-folders-flag " -recurse" "")
|
||||
" -sequence " seq " -noshowzero -fast` ; do\n"
|
||||
(expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n"
|
||||
"done\n"))
|
||||
(call-process-region
|
||||
(point-min) (point-max) "sh" nil (get-buffer mh-temp-index-buffer))))
|
||||
|
||||
|
||||
|
||||
;;; Folder navigation and utilities
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-group-by-folder ()
|
||||
"Partition the messages based on source folder.
|
||||
Returns an alist with the the folder names in the car and the cdr
|
||||
being the list of messages originally from that folder."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let ((result-table (make-hash-table :test #'equal)))
|
||||
(loop for msg being hash-keys of mh-index-msg-checksum-map
|
||||
do (push msg (gethash (car (gethash
|
||||
(gethash msg mh-index-msg-checksum-map)
|
||||
mh-index-checksum-origin-map))
|
||||
result-table)))
|
||||
(loop for x being the hash-keys of result-table
|
||||
collect (cons x (nreverse (gethash x result-table)))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-insert-folder-headers ()
|
||||
"Annotate the search results with original folder names."
|
||||
(let ((cur-msg (mh-get-msg-num nil))
|
||||
(old-buffer-modified-flag (buffer-modified-p))
|
||||
(buffer-read-only nil)
|
||||
current-folder last-folder)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
|
||||
mh-index-msg-checksum-map)
|
||||
mh-index-checksum-origin-map)))
|
||||
(when (and current-folder (not (equal current-folder last-folder)))
|
||||
(insert (if last-folder "\n" "") current-folder "\n")
|
||||
(setq last-folder current-folder))
|
||||
(forward-line))
|
||||
(when cur-msg
|
||||
(mh-notate-cur)
|
||||
(mh-goto-msg cur-msg t))
|
||||
(set-buffer-modified-p old-buffer-modified-flag))
|
||||
(mh-index-create-imenu-index))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-delete-folder-headers ()
|
||||
"Delete the folder headers."
|
||||
(let ((cur-msg (mh-get-msg-num nil))
|
||||
(old-buffer-modified-flag (buffer-modified-p))
|
||||
(buffer-read-only nil))
|
||||
(while (and (not cur-msg) (not (eobp)))
|
||||
(forward-line)
|
||||
(setq cur-msg (mh-get-msg-num nil)))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
|
||||
(delete-region (point) (progn (forward-line) (point)))
|
||||
(forward-line)))
|
||||
(when cur-msg (mh-goto-msg cur-msg t t))
|
||||
(set-buffer-modified-p old-buffer-modified-flag)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-create-imenu-index ()
|
||||
"Create alist of folder names and positions in index folder buffers."
|
||||
(save-excursion
|
||||
(setq which-func-mode t)
|
||||
(let ((alist ()))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^+" nil t)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(push (cons (buffer-substring-no-properties
|
||||
(point) (line-end-position))
|
||||
(set-marker (make-marker) (point)))
|
||||
alist)))
|
||||
(setq imenu--index-alist (nreverse alist)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-next-folder (&optional backward-flag)
|
||||
"Jump to the next folder marker.
|
||||
|
||||
With non-nil optional argument BACKWARD-FLAG, jump to the previous
|
||||
group of results."
|
||||
(interactive "P")
|
||||
(if (null mh-index-data)
|
||||
(message "Only applicable in an MH-E index search buffer")
|
||||
(let ((point (point)))
|
||||
(forward-line (if backward-flag 0 1))
|
||||
(cond ((if backward-flag
|
||||
(re-search-backward "^+" (point-min) t)
|
||||
(re-search-forward "^+" (point-max) t))
|
||||
(beginning-of-line))
|
||||
((and (if backward-flag
|
||||
(goto-char (point-max))
|
||||
(goto-char (point-min)))
|
||||
nil))
|
||||
((if backward-flag
|
||||
(re-search-backward "^+" (point-min) t)
|
||||
(re-search-forward "^+" (point-max) t))
|
||||
(beginning-of-line))
|
||||
(t (goto-char point))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-previous-folder ()
|
||||
"Jump to the previous folder marker."
|
||||
(interactive)
|
||||
(mh-index-next-folder t))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-visit-folder ()
|
||||
"Visit original folder from where the message at point was found."
|
||||
(interactive)
|
||||
(unless mh-index-data
|
||||
(error "Not in an index folder"))
|
||||
(let (folder msg)
|
||||
(save-excursion
|
||||
(cond ((and (bolp) (eolp))
|
||||
(ignore-errors (forward-line -1))
|
||||
(setq msg (mh-get-msg-num t)))
|
||||
((equal (char-after (line-beginning-position)) ?+)
|
||||
(setq folder (buffer-substring-no-properties
|
||||
(line-beginning-position) (line-end-position))))
|
||||
(t (setq msg (mh-get-msg-num t)))))
|
||||
(when (not folder)
|
||||
(setq folder (car (gethash (gethash msg mh-index-msg-checksum-map)
|
||||
mh-index-checksum-origin-map))))
|
||||
(when (or (not (get-buffer folder))
|
||||
(y-or-n-p (format "Reuse buffer displaying %s? " folder)))
|
||||
(mh-visit-folder
|
||||
folder (loop for x being the hash-keys of (gethash folder mh-index-data)
|
||||
when (mh-msg-exists-p x folder) collect x)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-search-p ()
|
||||
"Non-nil means that this folder was generated by searching."
|
||||
mh-index-data)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-execute-commands ()
|
||||
"Delete/refile the actual messages.
|
||||
The copies in the searched folder are then deleted/refiled to get
|
||||
the desired result. Before deleting the messages we make sure
|
||||
that the message being deleted is identical to the one that the
|
||||
user has marked in the index buffer."
|
||||
(save-excursion
|
||||
(let ((folders ())
|
||||
(mh-speed-flists-inhibit-flag t))
|
||||
(maphash
|
||||
(lambda (folder msgs)
|
||||
(push folder folders)
|
||||
(if (not (get-buffer folder))
|
||||
;; If source folder not open, just delete the messages...
|
||||
(apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))
|
||||
;; Otherwise delete the messages in the source buffer...
|
||||
(save-excursion
|
||||
(set-buffer folder)
|
||||
(let ((old-refile-list mh-refile-list)
|
||||
(old-delete-list mh-delete-list))
|
||||
(setq mh-refile-list nil
|
||||
mh-delete-list msgs)
|
||||
(unwind-protect (mh-execute-commands)
|
||||
(setq mh-refile-list
|
||||
(mapcar (lambda (x)
|
||||
(cons (car x)
|
||||
(loop for y in (cdr x)
|
||||
unless (memq y msgs) collect y)))
|
||||
old-refile-list)
|
||||
mh-delete-list
|
||||
(loop for x in old-delete-list
|
||||
unless (memq x msgs) collect x))
|
||||
(mh-set-folder-modified-p (mh-outstanding-commands-p))
|
||||
(when (mh-outstanding-commands-p)
|
||||
(mh-notate-deleted-and-refiled)))))))
|
||||
(mh-index-matching-source-msgs (append (loop for x in mh-refile-list
|
||||
append (cdr x))
|
||||
mh-delete-list)
|
||||
t))
|
||||
folders)))
|
||||
|
||||
|
||||
|
||||
;;; Indexing functions
|
||||
;;; Indexing Functions
|
||||
|
||||
;; Support different search programs
|
||||
(defvar mh-search-choices
|
||||
|
|
@ -930,14 +824,13 @@ optional argument SEARCHER is present, use it instead of
|
|||
(return mh-searcher))))
|
||||
nil)))
|
||||
|
||||
;;; Swish++ interface
|
||||
;;; Swish++
|
||||
|
||||
(defvar mh-swish++-binary (or (executable-find "search++")
|
||||
(executable-find "search")))
|
||||
(defvar mh-swish++-directory ".swish++")
|
||||
(defvar mh-swish-folder nil)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-swish++-execute-search (folder-path search-regexp)
|
||||
"Execute swish++.
|
||||
|
||||
|
|
@ -1012,12 +905,11 @@ REGEXP-LIST is an alist of fields and values."
|
|||
(symbol-name (car expr))
|
||||
(mh-swish++-print-regexp (caddr expr))))))
|
||||
|
||||
;;; Swish interface
|
||||
;;; Swish
|
||||
|
||||
(defvar mh-swish-binary (executable-find "swish-e"))
|
||||
(defvar mh-swish-directory ".swish")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-swish-execute-search (folder-path search-regexp)
|
||||
"Execute swish-e.
|
||||
|
||||
|
|
@ -1110,13 +1002,12 @@ is used to search."
|
|||
nil)))
|
||||
(forward-line)))
|
||||
|
||||
;;; Mairix interface
|
||||
;;; Mairix
|
||||
|
||||
(defvar mh-mairix-binary (executable-find "mairix"))
|
||||
(defvar mh-mairix-directory ".mairix")
|
||||
(defvar mh-mairix-folder nil)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-mairix-execute-search (folder-path search-regexp-list)
|
||||
"Execute mairix.
|
||||
|
||||
|
|
@ -1244,13 +1135,12 @@ REGEXP-LIST is an alist of fields and values."
|
|||
(cdadr expr)))))
|
||||
(t (error "Unreachable: %s" expr))))
|
||||
|
||||
;;; Namazu interface
|
||||
;;; Namazu
|
||||
|
||||
(defvar mh-namazu-binary (executable-find "namazu"))
|
||||
(defvar mh-namazu-directory ".namazu")
|
||||
(defvar mh-namazu-folder nil)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-namazu-execute-search (folder-path search-regexp)
|
||||
"Execute namazu.
|
||||
|
||||
|
|
@ -1317,14 +1207,13 @@ is used to search."
|
|||
nil))))
|
||||
(forward-line)))
|
||||
|
||||
;;; Pick interface
|
||||
;;; Pick
|
||||
|
||||
(defvar mh-index-pick-folder)
|
||||
(defvar mh-pick-binary "pick")
|
||||
(defconst mh-pick-single-dash '(cc date from subject to)
|
||||
"Search components that are supported by single-dash option in pick.")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-pick-execute-search (folder-path search-regexp)
|
||||
"Execute pick.
|
||||
|
||||
|
|
@ -1408,11 +1297,10 @@ COMPONENT is the component to search."
|
|||
"-rbrace"))
|
||||
(t (error "Unknown operator %s seen" (car expr)))))
|
||||
|
||||
;;; Grep interface
|
||||
;;; Grep
|
||||
|
||||
(defvar mh-grep-binary (executable-find "grep"))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-grep-execute-search (folder-path search-regexp)
|
||||
"Execute grep.
|
||||
|
||||
|
|
@ -1463,7 +1351,132 @@ record is invalid return 'error."
|
|||
|
||||
|
||||
|
||||
;;; Folder support
|
||||
;;; Folder Utilities
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-group-by-folder ()
|
||||
"Partition the messages based on source folder.
|
||||
Returns an alist with the the folder names in the car and the cdr
|
||||
being the list of messages originally from that folder."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let ((result-table (make-hash-table :test #'equal)))
|
||||
(loop for msg being hash-keys of mh-index-msg-checksum-map
|
||||
do (push msg (gethash (car (gethash
|
||||
(gethash msg mh-index-msg-checksum-map)
|
||||
mh-index-checksum-origin-map))
|
||||
result-table)))
|
||||
(loop for x being the hash-keys of result-table
|
||||
collect (cons x (nreverse (gethash x result-table)))))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-insert-folder-headers ()
|
||||
"Annotate the search results with original folder names."
|
||||
(let ((cur-msg (mh-get-msg-num nil))
|
||||
(old-buffer-modified-flag (buffer-modified-p))
|
||||
(buffer-read-only nil)
|
||||
current-folder last-folder)
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(setq current-folder (car (gethash (gethash (mh-get-msg-num nil)
|
||||
mh-index-msg-checksum-map)
|
||||
mh-index-checksum-origin-map)))
|
||||
(when (and current-folder (not (equal current-folder last-folder)))
|
||||
(insert (if last-folder "\n" "") current-folder "\n")
|
||||
(setq last-folder current-folder))
|
||||
(forward-line))
|
||||
(when cur-msg
|
||||
(mh-notate-cur)
|
||||
(mh-goto-msg cur-msg t))
|
||||
(set-buffer-modified-p old-buffer-modified-flag))
|
||||
(mh-index-create-imenu-index))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-delete-folder-headers ()
|
||||
"Delete the folder headers."
|
||||
(let ((cur-msg (mh-get-msg-num nil))
|
||||
(old-buffer-modified-flag (buffer-modified-p))
|
||||
(buffer-read-only nil))
|
||||
(while (and (not cur-msg) (not (eobp)))
|
||||
(forward-line)
|
||||
(setq cur-msg (mh-get-msg-num nil)))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(if (or (char-equal (char-after) ?+) (char-equal (char-after) 10))
|
||||
(delete-region (point) (progn (forward-line) (point)))
|
||||
(forward-line)))
|
||||
(when cur-msg (mh-goto-msg cur-msg t t))
|
||||
(set-buffer-modified-p old-buffer-modified-flag)))
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile (mh-do-in-xemacs (defvar which-func-mode)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-create-imenu-index ()
|
||||
"Create alist of folder names and positions in index folder buffers."
|
||||
(save-excursion
|
||||
(if (boundp 'which-func-mode)
|
||||
(setq which-func-mode t))
|
||||
(let ((alist ()))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^+" nil t)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(push (cons (buffer-substring-no-properties
|
||||
(point) (line-end-position))
|
||||
(set-marker (make-marker) (point)))
|
||||
alist)))
|
||||
(setq imenu--index-alist (nreverse alist)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-search-p ()
|
||||
"Non-nil means that this folder was generated by searching."
|
||||
mh-index-data)
|
||||
|
||||
;; Shush compiler
|
||||
(eval-when-compile (if mh-xemacs-flag (defvar mh-speed-flists-inhibit-flag)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-execute-commands ()
|
||||
"Delete/refile the actual messages.
|
||||
The copies in the searched folder are then deleted/refiled to get
|
||||
the desired result. Before deleting the messages we make sure
|
||||
that the message being deleted is identical to the one that the
|
||||
user has marked in the index buffer."
|
||||
(save-excursion
|
||||
(let ((folders ())
|
||||
(mh-speed-flists-inhibit-flag t))
|
||||
(maphash
|
||||
(lambda (folder msgs)
|
||||
(push folder folders)
|
||||
(if (not (get-buffer folder))
|
||||
;; If source folder not open, just delete the messages...
|
||||
(apply #'mh-exec-cmd "rmm" folder (mh-coalesce-msg-list msgs))
|
||||
;; Otherwise delete the messages in the source buffer...
|
||||
(save-excursion
|
||||
(set-buffer folder)
|
||||
(let ((old-refile-list mh-refile-list)
|
||||
(old-delete-list mh-delete-list))
|
||||
(setq mh-refile-list nil
|
||||
mh-delete-list msgs)
|
||||
(unwind-protect (mh-execute-commands)
|
||||
(setq mh-refile-list
|
||||
(mapcar (lambda (x)
|
||||
(cons (car x)
|
||||
(loop for y in (cdr x)
|
||||
unless (memq y msgs) collect y)))
|
||||
old-refile-list)
|
||||
mh-delete-list
|
||||
(loop for x in old-delete-list
|
||||
unless (memq x msgs) collect x))
|
||||
(mh-set-folder-modified-p (mh-outstanding-commands-p))
|
||||
(when (mh-outstanding-commands-p)
|
||||
(mh-notate-deleted-and-refiled)))))))
|
||||
(mh-index-matching-source-msgs (append (loop for x in mh-refile-list
|
||||
append (cdr x))
|
||||
mh-delete-list)
|
||||
t))
|
||||
folders)))
|
||||
|
||||
(defun mh-index-generate-pretty-name (string)
|
||||
"Given STRING generate a name which is suitable for use as a folder name.
|
||||
|
|
@ -1559,7 +1572,7 @@ garbled."
|
|||
|
||||
|
||||
|
||||
;;; Sequence support
|
||||
;;; Sequence Support
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-index-create-sequences ()
|
||||
|
|
@ -1688,7 +1701,7 @@ folder, is removed from `mh-index-data'."
|
|||
|
||||
|
||||
|
||||
;;; Serialization of index data
|
||||
;;; Serialization of Index Data
|
||||
|
||||
(defun mh-index-write-data ()
|
||||
"Write index data to file."
|
||||
|
|
@ -1756,20 +1769,21 @@ PROC is used to convert the value to actual data."
|
|||
|
||||
|
||||
|
||||
;;; Checksum routines
|
||||
;;; Checksum Routines
|
||||
|
||||
;; A few different checksum programs are supported. The supported
|
||||
;; programs are:
|
||||
|
||||
;; A few different checksum programs are supported. The supported programs
|
||||
;; are:
|
||||
;;
|
||||
;; 1. md5sum
|
||||
;; 2. md5
|
||||
;; 3. openssl
|
||||
;;
|
||||
;; To add support for your favorite checksum program add a clause to the cond
|
||||
;; statement in mh-checksum-choose. This should set the variable
|
||||
;; mh-checksum-cmd to the command line needed to run the checsum program and
|
||||
;; should set mh-checksum-parser to a function which returns a cons cell
|
||||
;; containing the message number and checksum string.
|
||||
|
||||
;; To add support for your favorite checksum program add a clause to
|
||||
;; the cond statement in mh-checksum-choose. This should set the
|
||||
;; variable mh-checksum-cmd to the command line needed to run the
|
||||
;; checsum program and should set mh-checksum-parser to a function
|
||||
;; which returns a cons cell containing the message number and
|
||||
;; checksum string.
|
||||
|
||||
(defvar mh-checksum-cmd)
|
||||
(defvar mh-checksum-parser)
|
||||
|
|
|
|||
1934
lisp/mh-e/mh-seq.el
1934
lisp/mh-e/mh-seq.el
File diff suppressed because it is too large
Load diff
907
lisp/mh-e/mh-show.el
Normal file
907
lisp/mh-e/mh-show.el
Normal file
|
|
@ -0,0 +1,907 @@
|
|||
;;; mh-show.el --- MH-Show mode
|
||||
|
||||
;; Copyright (C) 1993, 1995, 1997,
|
||||
;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Bill Wohler <wohler@newt.com>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Mode for showing messages.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mh-e)
|
||||
(require 'mh-scan)
|
||||
|
||||
(require 'gnus-cite)
|
||||
(require 'gnus-util)
|
||||
|
||||
(autoload 'mh-make-buffer-data "mh-mime") ;can't be automatically generated
|
||||
|
||||
(require 'font-lock)
|
||||
|
||||
|
||||
|
||||
;;; MH-Folder Commands
|
||||
|
||||
(defvar mh-showing-with-headers nil
|
||||
"If non-nil, MH-Show buffer contains message with all header fields.
|
||||
If nil, MH-Show buffer contains message processed normally.")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-show (&optional message redisplay-flag)
|
||||
"Display message\\<mh-folder-mode-map>.
|
||||
|
||||
If the message under the cursor is already displayed, this command
|
||||
scrolls to the beginning of the message. MH-E normally hides a lot of
|
||||
the superfluous header fields that mailers add to a message, but if
|
||||
you wish to see all of them, use the command \\[mh-header-display].
|
||||
|
||||
Two hooks can be used to control how messages are displayed. The
|
||||
first hook, `mh-show-mode-hook', is called early on in the
|
||||
process of the message display. It is usually used to perform
|
||||
some action on the message's content. The second hook,
|
||||
`mh-show-hook', is the last thing called after messages are
|
||||
displayed. It's used to affect the behavior of MH-E in general or
|
||||
when `mh-show-mode-hook' is too early.
|
||||
|
||||
From a program, optional argument MESSAGE can be used to display an
|
||||
alternative message. The optional argument REDISPLAY-FLAG forces the
|
||||
redisplay of the message even if the show buffer was already
|
||||
displaying the correct message.
|
||||
|
||||
See the \"mh-show\" customization group for a litany of options that
|
||||
control what displayed messages look like."
|
||||
(interactive (list nil t))
|
||||
(when (or redisplay-flag
|
||||
(and mh-showing-with-headers
|
||||
(or mh-mhl-format-file mh-clean-message-header-flag)))
|
||||
(mh-invalidate-show-buffer))
|
||||
(mh-show-msg message))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-header-display ()
|
||||
"Display message with all header fields\\<mh-folder-mode-map>.
|
||||
|
||||
Use the command \\[mh-show] to show the message normally again."
|
||||
(interactive)
|
||||
(and (not mh-showing-with-headers)
|
||||
(or mh-mhl-format-file mh-clean-message-header-flag)
|
||||
(mh-invalidate-show-buffer))
|
||||
(let ((mh-decode-mime-flag nil)
|
||||
(mh-mhl-format-file nil)
|
||||
(mh-clean-message-header-flag nil))
|
||||
(mh-show-msg nil)
|
||||
(mh-in-show-buffer (mh-show-buffer)
|
||||
(goto-char (point-min))
|
||||
(mh-recenter 0))
|
||||
(setq mh-showing-with-headers t)))
|
||||
|
||||
|
||||
|
||||
;;; Support Routines for MH-Folder Commands
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-maybe-show (&optional msg)
|
||||
"Display message at cursor, but only if in show mode.
|
||||
If optional arg MSG is non-nil, display that message instead."
|
||||
(if mh-showing-mode (mh-show msg)))
|
||||
|
||||
(defun mh-show-msg (msg)
|
||||
"Show MSG.
|
||||
|
||||
The hook `mh-show-hook' is called after the message has been
|
||||
displayed."
|
||||
(if (not msg)
|
||||
(setq msg (mh-get-msg-num t)))
|
||||
(mh-showing-mode t)
|
||||
(setq mh-page-to-next-msg-flag nil)
|
||||
(let ((folder mh-current-folder)
|
||||
(folders (list mh-current-folder))
|
||||
(clean-message-header mh-clean-message-header-flag)
|
||||
(show-window (get-buffer-window mh-show-buffer))
|
||||
(display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag))
|
||||
(if (not (eq (next-window (minibuffer-window)) (selected-window)))
|
||||
(delete-other-windows)) ; force ourself to the top window
|
||||
(mh-in-show-buffer (mh-show-buffer)
|
||||
(setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag)
|
||||
(if (and show-window
|
||||
(equal (mh-msg-filename msg folder) buffer-file-name))
|
||||
(progn ;just back up to start
|
||||
(goto-char (point-min))
|
||||
(if (not clean-message-header)
|
||||
(mh-start-of-uncleaned-message)))
|
||||
(mh-display-msg msg folder)))
|
||||
(if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split
|
||||
(shrink-window (- (window-height) (or mh-summary-height
|
||||
(mh-summary-height)))))
|
||||
(mh-recenter nil)
|
||||
;; The following line is a nop which forces update of the scan line so
|
||||
;; that font-lock will update it (if needed)...
|
||||
(mh-notate nil nil mh-cmd-note)
|
||||
(if (not (memq msg mh-seen-list))
|
||||
(setq mh-seen-list (cons msg mh-seen-list)))
|
||||
(when mh-update-sequences-after-mh-show-flag
|
||||
(mh-update-sequences)
|
||||
(when mh-index-data
|
||||
(setq folders
|
||||
(append (mh-index-delete-from-sequence mh-unseen-seq (list msg))
|
||||
folders)))
|
||||
(when (mh-speed-flists-active-p)
|
||||
(apply #'mh-speed-flists t folders)))
|
||||
(run-hooks 'mh-show-hook)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-showing-mode (&optional arg)
|
||||
"Change whether messages should be displayed.
|
||||
|
||||
With ARG, display messages iff ARG is positive."
|
||||
(setq mh-showing-mode
|
||||
(if (null arg)
|
||||
(not mh-showing-mode)
|
||||
(> (prefix-numeric-value arg) 0))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-start-of-uncleaned-message ()
|
||||
"Position uninteresting headers off the top of the window."
|
||||
(let ((case-fold-search t))
|
||||
(re-search-forward
|
||||
"^To:\\|^Cc:\\|^From:\\|^Subject:\\|^Date:" nil t)
|
||||
(beginning-of-line)
|
||||
(mh-recenter 0)))
|
||||
|
||||
(defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d"
|
||||
"Format string to produce `mode-line-buffer-identification' for show buffers.
|
||||
|
||||
First argument is folder name. Second is message number.")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-display-msg (msg-num folder-name)
|
||||
"Display MSG-NUM of FOLDER-NAME.
|
||||
Sets the current buffer to the show buffer."
|
||||
(let ((folder (mh-msg-folder folder-name)))
|
||||
(set-buffer folder)
|
||||
;; When Gnus uses external displayers it has to keep handles longer. So
|
||||
;; we will delete these handles when mh-quit is called on the folder. It
|
||||
;; would be nicer if there are weak pointers in emacs lisp, then we could
|
||||
;; get the garbage collector to do this for us.
|
||||
(unless (mh-buffer-data)
|
||||
(setf (mh-buffer-data) (mh-make-buffer-data)))
|
||||
;; Bind variables in folder buffer in case they are local
|
||||
(let ((formfile mh-mhl-format-file)
|
||||
(clean-message-header mh-clean-message-header-flag)
|
||||
(invisible-headers mh-invisible-header-fields-compiled)
|
||||
(visible-headers nil)
|
||||
(msg-filename (mh-msg-filename msg-num folder-name))
|
||||
(show-buffer mh-show-buffer)
|
||||
(mm-inline-media-tests mh-mm-inline-media-tests))
|
||||
(if (not (file-exists-p msg-filename))
|
||||
(error "Message %d does not exist" msg-num))
|
||||
(if (and (> mh-show-maximum-size 0)
|
||||
(> (elt (file-attributes msg-filename) 7)
|
||||
mh-show-maximum-size)
|
||||
(not (y-or-n-p
|
||||
(format
|
||||
"Message %d (%d bytes) exceeds %d bytes. Display it? "
|
||||
msg-num (elt (file-attributes msg-filename) 7)
|
||||
mh-show-maximum-size))))
|
||||
(error "Message %d not displayed" msg-num))
|
||||
(set-buffer show-buffer)
|
||||
(cond ((not (equal msg-filename buffer-file-name))
|
||||
(mh-unvisit-file)
|
||||
(setq buffer-read-only nil)
|
||||
;; Cleanup old mime handles
|
||||
(mh-mime-cleanup)
|
||||
(erase-buffer)
|
||||
;; Changing contents, so this hook needs to be reinitialized.
|
||||
;; pgp.el uses this.
|
||||
(if (boundp 'write-contents-hooks) ;Emacs 19
|
||||
(kill-local-variable 'write-contents-hooks))
|
||||
(if formfile
|
||||
(mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
|
||||
(if (stringp formfile)
|
||||
(list "-form" formfile))
|
||||
msg-filename)
|
||||
(insert-file-contents-literally msg-filename))
|
||||
;; Use mm to display buffer
|
||||
(when (and mh-decode-mime-flag (not formfile))
|
||||
(mh-add-missing-mime-version-header)
|
||||
(setf (mh-buffer-data) (mh-make-buffer-data))
|
||||
(mh-mime-display))
|
||||
(mh-show-mode)
|
||||
;; Header cleanup
|
||||
(goto-char (point-min))
|
||||
(cond (clean-message-header
|
||||
(mh-clean-msg-header (point-min)
|
||||
invisible-headers
|
||||
visible-headers)
|
||||
(goto-char (point-min)))
|
||||
(t
|
||||
(mh-start-of-uncleaned-message)))
|
||||
(mh-decode-message-header)
|
||||
;; the parts of visiting we want to do (no locking)
|
||||
(or (eq buffer-undo-list t) ;don't save undo info for prev msgs
|
||||
(setq buffer-undo-list nil))
|
||||
(set-buffer-auto-saved)
|
||||
;; the parts of set-visited-file-name we want to do (no locking)
|
||||
(setq buffer-file-name msg-filename)
|
||||
(setq buffer-backed-up nil)
|
||||
(auto-save-mode 1)
|
||||
(set-mark nil)
|
||||
(unwind-protect
|
||||
(when (and mh-decode-mime-flag (not formfile))
|
||||
(setq buffer-read-only nil)
|
||||
(mh-display-smileys)
|
||||
(mh-display-emphasis))
|
||||
(setq buffer-read-only t))
|
||||
(set-buffer-modified-p nil)
|
||||
(setq mh-show-folder-buffer folder)
|
||||
(setq mode-line-buffer-identification
|
||||
(list (format mh-show-buffer-mode-line-buffer-id
|
||||
folder-name msg-num)))
|
||||
(mh-logo-display)
|
||||
(set-buffer folder)
|
||||
(setq mh-showing-with-headers nil))))))
|
||||
|
||||
(defun mh-msg-folder (folder-name)
|
||||
"Return the name of the buffer for FOLDER-NAME."
|
||||
folder-name)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-clean-msg-header (start invisible-headers visible-headers)
|
||||
"Flush extraneous lines in message header.
|
||||
|
||||
Header is cleaned from START to the end of the message header.
|
||||
INVISIBLE-HEADERS contains a regular expression specifying lines
|
||||
to delete from the header. VISIBLE-HEADERS contains a regular
|
||||
expression specifying the lines to display. INVISIBLE-HEADERS is
|
||||
ignored if VISIBLE-HEADERS is non-nil."
|
||||
;; XXX Note that MH-E no longer supports the `mh-visible-headers'
|
||||
;; variable, so this function could be trimmed of this feature too."
|
||||
(let ((case-fold-search t)
|
||||
(buffer-read-only nil))
|
||||
(save-restriction
|
||||
(goto-char start)
|
||||
(if (search-forward "\n\n" nil 'move)
|
||||
(backward-char 1))
|
||||
(narrow-to-region start (point))
|
||||
(goto-char (point-min))
|
||||
(if visible-headers
|
||||
(while (< (point) (point-max))
|
||||
(cond ((looking-at visible-headers)
|
||||
(forward-line 1)
|
||||
(while (looking-at "[ \t]") (forward-line 1)))
|
||||
(t
|
||||
(mh-delete-line 1)
|
||||
(while (looking-at "[ \t]")
|
||||
(mh-delete-line 1)))))
|
||||
(while (re-search-forward invisible-headers nil t)
|
||||
(beginning-of-line)
|
||||
(mh-delete-line 1)
|
||||
(while (looking-at "[ \t]")
|
||||
(mh-delete-line 1)))))
|
||||
(let ((mh-compose-skipped-header-fields ()))
|
||||
(mh-letter-hide-all-skipped-fields))
|
||||
(unlock-buffer)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-invalidate-show-buffer ()
|
||||
"Invalidate the show buffer so we must update it to use it."
|
||||
(if (get-buffer mh-show-buffer)
|
||||
(save-excursion
|
||||
(set-buffer mh-show-buffer)
|
||||
(mh-unvisit-file))))
|
||||
|
||||
(defun mh-unvisit-file ()
|
||||
"Separate current buffer from the message file it was visiting."
|
||||
(or (not (buffer-modified-p))
|
||||
(null buffer-file-name) ;we've been here before
|
||||
(yes-or-no-p (format "Message %s modified; flush changes? "
|
||||
(file-name-nondirectory buffer-file-name)))
|
||||
(error "Flushing changes not confirmed"))
|
||||
(clear-visited-file-modtime)
|
||||
(unlock-buffer)
|
||||
(setq buffer-file-name nil))
|
||||
|
||||
(defun mh-summary-height ()
|
||||
"Return ideal value for the variable `mh-summary-height'.
|
||||
The current frame height is taken into consideration."
|
||||
(or (and (fboundp 'frame-height)
|
||||
(> (frame-height) 24)
|
||||
(min 10 (/ (frame-height) 6)))
|
||||
4))
|
||||
|
||||
|
||||
|
||||
;; Infrastructure to generate show-buffer functions from folder functions
|
||||
;; XEmacs does not have deactivate-mark? What is the equivalent of
|
||||
;; transient-mark-mode for XEmacs? Should we be restoring the mark in the
|
||||
;; folder buffer after the operation has been carried out.
|
||||
(defmacro mh-defun-show-buffer (function original-function
|
||||
&optional dont-return)
|
||||
"Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer.
|
||||
If the buffer we start in is still visible and DONT-RETURN is nil
|
||||
then switch to it after that."
|
||||
`(defun ,function ()
|
||||
,(format "Calls %s from the message's folder.\n%s\nSee \"%s\" for more info.\n"
|
||||
original-function
|
||||
(if dont-return ""
|
||||
"When function completes, returns to the show buffer if it is
|
||||
still visible.\n")
|
||||
original-function)
|
||||
(interactive)
|
||||
(when (buffer-live-p (get-buffer mh-show-folder-buffer))
|
||||
(let ((config (current-window-configuration))
|
||||
(folder-buffer mh-show-folder-buffer)
|
||||
(normal-exit nil)
|
||||
,@(if dont-return () '((cur-buffer-name (buffer-name)))))
|
||||
(pop-to-buffer mh-show-folder-buffer nil)
|
||||
(unless (equal (buffer-name
|
||||
(window-buffer (frame-first-window (selected-frame))))
|
||||
folder-buffer)
|
||||
(delete-other-windows))
|
||||
(mh-goto-cur-msg t)
|
||||
(mh-funcall-if-exists deactivate-mark)
|
||||
(unwind-protect
|
||||
(prog1 (call-interactively (function ,original-function))
|
||||
(setq normal-exit t))
|
||||
(mh-funcall-if-exists deactivate-mark)
|
||||
(when (eq major-mode 'mh-folder-mode)
|
||||
(mh-funcall-if-exists hl-line-highlight))
|
||||
(cond ((not normal-exit)
|
||||
(set-window-configuration config))
|
||||
,(if dont-return
|
||||
`(t (setq mh-previous-window-config config))
|
||||
`((and (get-buffer cur-buffer-name)
|
||||
(window-live-p (get-buffer-window
|
||||
(get-buffer cur-buffer-name))))
|
||||
(pop-to-buffer (get-buffer cur-buffer-name) nil)))))))))
|
||||
|
||||
;; Generate interactive functions for the show buffer from the corresponding
|
||||
;; folder functions.
|
||||
(mh-defun-show-buffer mh-show-previous-undeleted-msg
|
||||
mh-previous-undeleted-msg)
|
||||
(mh-defun-show-buffer mh-show-next-undeleted-msg
|
||||
mh-next-undeleted-msg)
|
||||
(mh-defun-show-buffer mh-show-quit mh-quit)
|
||||
(mh-defun-show-buffer mh-show-delete-msg mh-delete-msg)
|
||||
(mh-defun-show-buffer mh-show-refile-msg mh-refile-msg)
|
||||
(mh-defun-show-buffer mh-show-undo mh-undo)
|
||||
(mh-defun-show-buffer mh-show-execute-commands mh-execute-commands)
|
||||
(mh-defun-show-buffer mh-show-reply mh-reply t)
|
||||
(mh-defun-show-buffer mh-show-redistribute mh-redistribute)
|
||||
(mh-defun-show-buffer mh-show-forward mh-forward t)
|
||||
(mh-defun-show-buffer mh-show-header-display mh-header-display)
|
||||
(mh-defun-show-buffer mh-show-refile-or-write-again
|
||||
mh-refile-or-write-again)
|
||||
(mh-defun-show-buffer mh-show-show mh-show)
|
||||
(mh-defun-show-buffer mh-show-write-message-to-file
|
||||
mh-write-msg-to-file)
|
||||
(mh-defun-show-buffer mh-show-extract-rejected-mail
|
||||
mh-extract-rejected-mail t)
|
||||
(mh-defun-show-buffer mh-show-delete-msg-no-motion
|
||||
mh-delete-msg-no-motion)
|
||||
(mh-defun-show-buffer mh-show-first-msg mh-first-msg)
|
||||
(mh-defun-show-buffer mh-show-last-msg mh-last-msg)
|
||||
(mh-defun-show-buffer mh-show-copy-msg mh-copy-msg)
|
||||
(mh-defun-show-buffer mh-show-edit-again mh-edit-again t)
|
||||
(mh-defun-show-buffer mh-show-goto-msg mh-goto-msg)
|
||||
(mh-defun-show-buffer mh-show-inc-folder mh-inc-folder)
|
||||
(mh-defun-show-buffer mh-show-delete-subject-or-thread
|
||||
mh-delete-subject-or-thread)
|
||||
(mh-defun-show-buffer mh-show-delete-subject mh-delete-subject)
|
||||
(mh-defun-show-buffer mh-show-print-msg mh-print-msg)
|
||||
(mh-defun-show-buffer mh-show-send mh-send t)
|
||||
(mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t)
|
||||
(mh-defun-show-buffer mh-show-pipe-msg mh-pipe-msg t)
|
||||
(mh-defun-show-buffer mh-show-sort-folder mh-sort-folder)
|
||||
(mh-defun-show-buffer mh-show-visit-folder mh-visit-folder t)
|
||||
(mh-defun-show-buffer mh-show-rescan-folder mh-rescan-folder)
|
||||
(mh-defun-show-buffer mh-show-pack-folder mh-pack-folder)
|
||||
(mh-defun-show-buffer mh-show-kill-folder mh-kill-folder t)
|
||||
(mh-defun-show-buffer mh-show-list-folders mh-list-folders t)
|
||||
(mh-defun-show-buffer mh-show-undo-folder mh-undo-folder)
|
||||
(mh-defun-show-buffer mh-show-delete-msg-from-seq
|
||||
mh-delete-msg-from-seq)
|
||||
(mh-defun-show-buffer mh-show-delete-seq mh-delete-seq)
|
||||
(mh-defun-show-buffer mh-show-list-sequences mh-list-sequences)
|
||||
(mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq)
|
||||
(mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq)
|
||||
(mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq)
|
||||
(mh-defun-show-buffer mh-show-widen mh-widen)
|
||||
(mh-defun-show-buffer mh-show-narrow-to-subject mh-narrow-to-subject)
|
||||
(mh-defun-show-buffer mh-show-narrow-to-from mh-narrow-to-from)
|
||||
(mh-defun-show-buffer mh-show-narrow-to-cc mh-narrow-to-cc)
|
||||
(mh-defun-show-buffer mh-show-narrow-to-range mh-narrow-to-range)
|
||||
(mh-defun-show-buffer mh-show-narrow-to-to mh-narrow-to-to)
|
||||
(mh-defun-show-buffer mh-show-store-msg mh-store-msg)
|
||||
(mh-defun-show-buffer mh-show-page-digest mh-page-digest)
|
||||
(mh-defun-show-buffer mh-show-page-digest-backwards
|
||||
mh-page-digest-backwards)
|
||||
(mh-defun-show-buffer mh-show-burst-digest mh-burst-digest)
|
||||
(mh-defun-show-buffer mh-show-page-msg mh-page-msg)
|
||||
(mh-defun-show-buffer mh-show-previous-page mh-previous-page)
|
||||
(mh-defun-show-buffer mh-show-modify mh-modify t)
|
||||
(mh-defun-show-buffer mh-show-next-button mh-next-button)
|
||||
(mh-defun-show-buffer mh-show-prev-button mh-prev-button)
|
||||
(mh-defun-show-buffer mh-show-toggle-mime-part mh-folder-toggle-mime-part)
|
||||
(mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part)
|
||||
(mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part)
|
||||
(mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads)
|
||||
(mh-defun-show-buffer mh-show-thread-delete mh-thread-delete)
|
||||
(mh-defun-show-buffer mh-show-thread-refile mh-thread-refile)
|
||||
(mh-defun-show-buffer mh-show-update-sequences mh-update-sequences)
|
||||
(mh-defun-show-buffer mh-show-next-unread-msg mh-next-unread-msg)
|
||||
(mh-defun-show-buffer mh-show-previous-unread-msg mh-previous-unread-msg)
|
||||
(mh-defun-show-buffer mh-show-thread-ancestor mh-thread-ancestor)
|
||||
(mh-defun-show-buffer mh-show-thread-next-sibling mh-thread-next-sibling)
|
||||
(mh-defun-show-buffer mh-show-thread-previous-sibling
|
||||
mh-thread-previous-sibling)
|
||||
(mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
|
||||
(mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick)
|
||||
(mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick)
|
||||
(mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist)
|
||||
(mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
|
||||
(mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
|
||||
(mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
|
||||
(mh-defun-show-buffer mh-show-index-sequenced-messages
|
||||
mh-index-sequenced-messages)
|
||||
(mh-defun-show-buffer mh-show-catchup mh-catchup)
|
||||
(mh-defun-show-buffer mh-show-ps-print-toggle-color mh-ps-print-toggle-color)
|
||||
(mh-defun-show-buffer mh-show-ps-print-toggle-faces mh-ps-print-toggle-faces)
|
||||
(mh-defun-show-buffer mh-show-ps-print-msg-file mh-ps-print-msg-file)
|
||||
(mh-defun-show-buffer mh-show-ps-print-msg mh-ps-print-msg)
|
||||
(mh-defun-show-buffer mh-show-toggle-mime-buttons mh-toggle-mime-buttons)
|
||||
(mh-defun-show-buffer mh-show-display-with-external-viewer
|
||||
mh-display-with-external-viewer)
|
||||
|
||||
|
||||
|
||||
;;; Sequence Menu
|
||||
|
||||
(easy-menu-define
|
||||
mh-show-sequence-menu mh-show-mode-map "Menu for MH-E folder-sequence."
|
||||
'("Sequence"
|
||||
["Add Message to Sequence..." mh-show-put-msg-in-seq t]
|
||||
["List Sequences for Message" mh-show-msg-is-in-seq t]
|
||||
["Delete Message from Sequence..." mh-show-delete-msg-from-seq t]
|
||||
["List Sequences in Folder..." mh-show-list-sequences t]
|
||||
["Delete Sequence..." mh-show-delete-seq t]
|
||||
["Narrow to Sequence..." mh-show-narrow-to-seq t]
|
||||
["Widen from Sequence" mh-show-widen t]
|
||||
"--"
|
||||
["Narrow to Subject Sequence" mh-show-narrow-to-subject t]
|
||||
["Narrow to Tick Sequence" mh-show-narrow-to-tick
|
||||
(save-excursion
|
||||
(set-buffer mh-show-folder-buffer)
|
||||
(and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq))))]
|
||||
["Delete Rest of Same Subject" mh-show-delete-subject t]
|
||||
["Toggle Tick Mark" mh-show-toggle-tick t]
|
||||
"--"
|
||||
["Push State Out to MH" mh-show-update-sequences t]))
|
||||
|
||||
;;; Message Menu
|
||||
|
||||
(easy-menu-define
|
||||
mh-show-message-menu mh-show-mode-map "Menu for MH-E folder-message."
|
||||
'("Message"
|
||||
["Show Message" mh-show-show t]
|
||||
["Show Message with Header" mh-show-header-display t]
|
||||
["Next Message" mh-show-next-undeleted-msg t]
|
||||
["Previous Message" mh-show-previous-undeleted-msg t]
|
||||
["Go to First Message" mh-show-first-msg t]
|
||||
["Go to Last Message" mh-show-last-msg t]
|
||||
["Go to Message by Number..." mh-show-goto-msg t]
|
||||
["Modify Message" mh-show-modify t]
|
||||
["Delete Message" mh-show-delete-msg t]
|
||||
["Refile Message" mh-show-refile-msg t]
|
||||
["Undo Delete/Refile" mh-show-undo t]
|
||||
["Process Delete/Refile" mh-show-execute-commands t]
|
||||
"--"
|
||||
["Compose a New Message" mh-send t]
|
||||
["Reply to Message..." mh-show-reply t]
|
||||
["Forward Message..." mh-show-forward t]
|
||||
["Redistribute Message..." mh-show-redistribute t]
|
||||
["Edit Message Again" mh-show-edit-again t]
|
||||
["Re-edit a Bounced Message" mh-show-extract-rejected-mail t]
|
||||
"--"
|
||||
["Copy Message to Folder..." mh-show-copy-msg t]
|
||||
["Print Message" mh-show-print-msg t]
|
||||
["Write Message to File..." mh-show-write-msg-to-file t]
|
||||
["Pipe Message to Command..." mh-show-pipe-msg t]
|
||||
["Unpack Uuencoded Message..." mh-show-store-msg t]
|
||||
["Burst Digest Message" mh-show-burst-digest t]))
|
||||
|
||||
;;; Folder Menu
|
||||
|
||||
(easy-menu-define
|
||||
mh-show-folder-menu mh-show-mode-map "Menu for MH-E folder."
|
||||
'("Folder"
|
||||
["Incorporate New Mail" mh-show-inc-folder t]
|
||||
["Toggle Show/Folder" mh-show-toggle-showing t]
|
||||
["Execute Delete/Refile" mh-show-execute-commands t]
|
||||
["Rescan Folder" mh-show-rescan-folder t]
|
||||
["Thread Folder" mh-show-toggle-threads t]
|
||||
["Pack Folder" mh-show-pack-folder t]
|
||||
["Sort Folder" mh-show-sort-folder t]
|
||||
"--"
|
||||
["List Folders" mh-show-list-folders t]
|
||||
["Visit a Folder..." mh-show-visit-folder t]
|
||||
["View New Messages" mh-show-index-new-messages t]
|
||||
["Search..." mh-search t]
|
||||
"--"
|
||||
["Quit MH-E" mh-quit t]))
|
||||
|
||||
|
||||
|
||||
;;; MH-Show Keys
|
||||
|
||||
(gnus-define-keys mh-show-mode-map
|
||||
" " mh-show-page-msg
|
||||
"!" mh-show-refile-or-write-again
|
||||
"'" mh-show-toggle-tick
|
||||
"," mh-show-header-display
|
||||
"." mh-show-show
|
||||
">" mh-show-write-message-to-file
|
||||
"?" mh-help
|
||||
"E" mh-show-extract-rejected-mail
|
||||
"M" mh-show-modify
|
||||
"\177" mh-show-previous-page
|
||||
"\C-d" mh-show-delete-msg-no-motion
|
||||
"\t" mh-show-next-button
|
||||
[backtab] mh-show-prev-button
|
||||
"\M-\t" mh-show-prev-button
|
||||
"\ed" mh-show-redistribute
|
||||
"^" mh-show-refile-msg
|
||||
"c" mh-show-copy-msg
|
||||
"d" mh-show-delete-msg
|
||||
"e" mh-show-edit-again
|
||||
"f" mh-show-forward
|
||||
"g" mh-show-goto-msg
|
||||
"i" mh-show-inc-folder
|
||||
"k" mh-show-delete-subject-or-thread
|
||||
"m" mh-show-send
|
||||
"n" mh-show-next-undeleted-msg
|
||||
"\M-n" mh-show-next-unread-msg
|
||||
"o" mh-show-refile-msg
|
||||
"p" mh-show-previous-undeleted-msg
|
||||
"\M-p" mh-show-previous-unread-msg
|
||||
"q" mh-show-quit
|
||||
"r" mh-show-reply
|
||||
"s" mh-show-send
|
||||
"t" mh-show-toggle-showing
|
||||
"u" mh-show-undo
|
||||
"x" mh-show-execute-commands
|
||||
"v" mh-show-index-visit-folder
|
||||
"|" mh-show-pipe-msg)
|
||||
|
||||
(gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
|
||||
"?" mh-prefix-help
|
||||
"'" mh-index-ticked-messages
|
||||
"S" mh-show-sort-folder
|
||||
"c" mh-show-catchup
|
||||
"f" mh-show-visit-folder
|
||||
"k" mh-show-kill-folder
|
||||
"l" mh-show-list-folders
|
||||
"n" mh-index-new-messages
|
||||
"o" mh-show-visit-folder
|
||||
"q" mh-show-index-sequenced-messages
|
||||
"r" mh-show-rescan-folder
|
||||
"s" mh-search
|
||||
"t" mh-show-toggle-threads
|
||||
"u" mh-show-undo-folder
|
||||
"v" mh-show-visit-folder)
|
||||
|
||||
(gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map)
|
||||
"'" mh-show-narrow-to-tick
|
||||
"?" mh-prefix-help
|
||||
"d" mh-show-delete-msg-from-seq
|
||||
"k" mh-show-delete-seq
|
||||
"l" mh-show-list-sequences
|
||||
"n" mh-show-narrow-to-seq
|
||||
"p" mh-show-put-msg-in-seq
|
||||
"s" mh-show-msg-is-in-seq
|
||||
"w" mh-show-widen)
|
||||
|
||||
(define-key mh-show-mode-map "I" mh-inc-spool-map)
|
||||
|
||||
(gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
|
||||
"?" mh-prefix-help
|
||||
"b" mh-show-junk-blacklist
|
||||
"w" mh-show-junk-whitelist)
|
||||
|
||||
(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
|
||||
"?" mh-prefix-help
|
||||
"C" mh-show-ps-print-toggle-color
|
||||
"F" mh-show-ps-print-toggle-faces
|
||||
"f" mh-show-ps-print-msg-file
|
||||
"l" mh-show-print-msg
|
||||
"p" mh-show-ps-print-msg)
|
||||
|
||||
(gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
|
||||
"?" mh-prefix-help
|
||||
"u" mh-show-thread-ancestor
|
||||
"p" mh-show-thread-previous-sibling
|
||||
"n" mh-show-thread-next-sibling
|
||||
"t" mh-show-toggle-threads
|
||||
"d" mh-show-thread-delete
|
||||
"o" mh-show-thread-refile)
|
||||
|
||||
(gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
|
||||
"'" mh-show-narrow-to-tick
|
||||
"?" mh-prefix-help
|
||||
"c" mh-show-narrow-to-cc
|
||||
"g" mh-show-narrow-to-range
|
||||
"m" mh-show-narrow-to-from
|
||||
"s" mh-show-narrow-to-subject
|
||||
"t" mh-show-narrow-to-to
|
||||
"w" mh-show-widen)
|
||||
|
||||
(gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map)
|
||||
"?" mh-prefix-help
|
||||
"s" mh-show-store-msg
|
||||
"u" mh-show-store-msg)
|
||||
|
||||
(gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map)
|
||||
"?" mh-prefix-help
|
||||
" " mh-show-page-digest
|
||||
"\177" mh-show-page-digest-backwards
|
||||
"b" mh-show-burst-digest)
|
||||
|
||||
(gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map)
|
||||
"?" mh-prefix-help
|
||||
"a" mh-mime-save-parts
|
||||
"e" mh-show-display-with-external-viewer
|
||||
"v" mh-show-toggle-mime-part
|
||||
"o" mh-show-save-mime-part
|
||||
"i" mh-show-inline-mime-part
|
||||
"t" mh-show-toggle-mime-buttons
|
||||
"\t" mh-show-next-button
|
||||
[backtab] mh-show-prev-button
|
||||
"\M-\t" mh-show-prev-button)
|
||||
|
||||
|
||||
|
||||
;;; MH-Show Font Lock
|
||||
|
||||
(defun mh-header-field-font-lock (field limit)
|
||||
"Return the value of a header field FIELD to font-lock.
|
||||
Argument LIMIT limits search."
|
||||
(if (= (point) limit)
|
||||
nil
|
||||
(let* ((mail-header-end (mh-mail-header-end))
|
||||
(lesser-limit (if (< mail-header-end limit) mail-header-end limit))
|
||||
(case-fold-search t))
|
||||
(when (and (< (point) mail-header-end) ;Only within header
|
||||
(re-search-forward (format "^%s" field) lesser-limit t))
|
||||
(let ((match-one-b (match-beginning 0))
|
||||
(match-one-e (match-end 0)))
|
||||
(mh-header-field-end)
|
||||
(if (> (point) limit) ;Don't search for end beyond limit
|
||||
(goto-char limit))
|
||||
(set-match-data (list match-one-b match-one-e
|
||||
(1+ match-one-e) (point)))
|
||||
t)))))
|
||||
|
||||
(defun mh-header-to-font-lock (limit)
|
||||
"Return the value of a header field To to font-lock.
|
||||
Argument LIMIT limits search."
|
||||
(mh-header-field-font-lock "To:" limit))
|
||||
|
||||
(defun mh-header-cc-font-lock (limit)
|
||||
"Return the value of a header field cc to font-lock.
|
||||
Argument LIMIT limits search."
|
||||
(mh-header-field-font-lock "cc:" limit))
|
||||
|
||||
(defun mh-header-subject-font-lock (limit)
|
||||
"Return the value of a header field Subject to font-lock.
|
||||
Argument LIMIT limits search."
|
||||
(mh-header-field-font-lock "Subject:" limit))
|
||||
|
||||
(defun mh-letter-header-font-lock (limit)
|
||||
"Return the entire mail header to font-lock.
|
||||
Argument LIMIT limits search."
|
||||
(if (= (point) limit)
|
||||
nil
|
||||
(let* ((mail-header-end (save-match-data (mh-mail-header-end)))
|
||||
(lesser-limit (if (< mail-header-end limit) mail-header-end limit)))
|
||||
(when (mh-in-header-p)
|
||||
(set-match-data (list 1 lesser-limit))
|
||||
(goto-char lesser-limit)
|
||||
t))))
|
||||
|
||||
(defun mh-show-font-lock-fontify-region (beg end loudly)
|
||||
"Limit font-lock in `mh-show-mode' to the header.
|
||||
|
||||
Used when the option `mh-highlight-citation-style' is set to
|
||||
\"Gnus\", leaving the body to be dealt with by Gnus highlighting.
|
||||
The region between BEG and END is given over to be fontified and
|
||||
LOUDLY controls if a user sees a message about the fontification
|
||||
operation."
|
||||
(let ((header-end (mh-mail-header-end)))
|
||||
(cond
|
||||
((and (< beg header-end)(< end header-end))
|
||||
(font-lock-default-fontify-region beg end loudly))
|
||||
((and (< beg header-end)(>= end header-end))
|
||||
(font-lock-default-fontify-region beg header-end loudly))
|
||||
(t
|
||||
nil))))
|
||||
|
||||
(defvar mh-show-font-lock-keywords
|
||||
'(("^\\(From:\\|Sender:\\)\\(.*\\)"
|
||||
(1 'default)
|
||||
(2 'mh-show-from))
|
||||
(mh-header-to-font-lock
|
||||
(0 'default)
|
||||
(1 'mh-show-to))
|
||||
(mh-header-cc-font-lock
|
||||
(0 'default)
|
||||
(1 'mh-show-cc))
|
||||
("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$"
|
||||
(1 'default)
|
||||
(2 'mh-show-from))
|
||||
(mh-header-subject-font-lock
|
||||
(0 'default)
|
||||
(1 'mh-show-subject))
|
||||
("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)"
|
||||
(1 'default)
|
||||
(2 'mh-show-cc))
|
||||
("^\\(In-reply-to\\|Date\\):\\(.*\\)$"
|
||||
(1 'default)
|
||||
(2 'mh-show-date))
|
||||
(mh-letter-header-font-lock
|
||||
(0 'mh-show-header append t)))
|
||||
"Additional expressions to highlight in MH-Show buffers.")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-show-font-lock-keywords ()
|
||||
"Return variable `mh-show-font-lock-keywords'."
|
||||
mh-show-font-lock-keywords)
|
||||
|
||||
(defvar mh-show-font-lock-keywords-with-cite
|
||||
(let* ((cite-chars "[>|}]")
|
||||
(cite-prefix "A-Za-z")
|
||||
(cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
|
||||
(append
|
||||
mh-show-font-lock-keywords
|
||||
(list
|
||||
;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
|
||||
`(,cite-chars
|
||||
(,(concat "\\=[ \t]*"
|
||||
"\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
|
||||
"\\(" cite-chars "[ \t]*\\)\\)+"
|
||||
"\\(.*\\)")
|
||||
(beginning-of-line) (end-of-line)
|
||||
(2 font-lock-constant-face nil t)
|
||||
(4 font-lock-comment-face nil t))))))
|
||||
"Additional expressions to highlight in MH-Show buffers.")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-show-font-lock-keywords-with-cite ()
|
||||
"Return variable `mh-show-font-lock-keywords-with-cite'."
|
||||
mh-show-font-lock-keywords-with-cite)
|
||||
|
||||
|
||||
|
||||
;;; MH-Show Mode
|
||||
|
||||
;; Ensure new buffers won't get this mode if default-major-mode is nil.
|
||||
(put 'mh-show-mode 'mode-class 'special)
|
||||
|
||||
;; Shush compiler.
|
||||
(eval-when-compile (defvar font-lock-auto-fontify))
|
||||
|
||||
;;;###mh-autoload
|
||||
(define-derived-mode mh-show-mode text-mode "MH-Show"
|
||||
"Major mode for showing messages in MH-E.\\<mh-show-mode-map>
|
||||
|
||||
The hook `mh-show-mode-hook' is called upon entry to this mode.
|
||||
|
||||
See also `mh-folder-mode'.
|
||||
|
||||
\\{mh-show-mode-map}"
|
||||
(set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
|
||||
(setq paragraph-start (default-value 'paragraph-start))
|
||||
(mh-show-unquote-From)
|
||||
(mh-show-xface)
|
||||
(mh-show-addr)
|
||||
(setq buffer-invisibility-spec '((vanish . t) t))
|
||||
(set (make-local-variable 'line-move-ignore-invisible) t)
|
||||
(make-local-variable 'font-lock-defaults)
|
||||
;;(set (make-local-variable 'font-lock-support-mode) nil)
|
||||
(cond
|
||||
((equal mh-highlight-citation-style 'font-lock)
|
||||
(setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
|
||||
((equal mh-highlight-citation-style 'gnus)
|
||||
(setq font-lock-defaults '((mh-show-font-lock-keywords)
|
||||
t nil nil nil
|
||||
(font-lock-fontify-region-function
|
||||
. mh-show-font-lock-fontify-region)))
|
||||
(mh-gnus-article-highlight-citation))
|
||||
(t
|
||||
(setq font-lock-defaults '(mh-show-font-lock-keywords t))))
|
||||
(if (and mh-xemacs-flag
|
||||
font-lock-auto-fontify)
|
||||
(turn-on-font-lock))
|
||||
(set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)
|
||||
(mh-funcall-if-exists mh-tool-bar-init :show)
|
||||
(when mh-decode-mime-flag
|
||||
(mh-make-local-hook 'kill-buffer-hook)
|
||||
(add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t))
|
||||
(easy-menu-add mh-show-sequence-menu)
|
||||
(easy-menu-add mh-show-message-menu)
|
||||
(easy-menu-add mh-show-folder-menu)
|
||||
(make-local-variable 'mh-show-folder-buffer)
|
||||
(buffer-disable-undo)
|
||||
(setq buffer-read-only t)
|
||||
(use-local-map mh-show-mode-map))
|
||||
|
||||
|
||||
|
||||
;;; Support Routines
|
||||
|
||||
(defun mh-show-unquote-From ()
|
||||
"Decode >From at beginning of lines for `mh-show-mode'."
|
||||
(save-excursion
|
||||
(let ((modified (buffer-modified-p))
|
||||
(case-fold-search nil)
|
||||
(buffer-read-only nil))
|
||||
(goto-char (mh-mail-header-end))
|
||||
(while (re-search-forward "^>From" nil t)
|
||||
(replace-match "From"))
|
||||
(set-buffer-modified-p modified))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-show-addr ()
|
||||
"Use `goto-address'."
|
||||
(when mh-show-use-goto-addr-flag
|
||||
(require 'goto-addr nil t)
|
||||
(if (fboundp 'goto-address)
|
||||
(goto-address))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-gnus-article-highlight-citation ()
|
||||
"Highlight cited text in current buffer using Gnus."
|
||||
(interactive)
|
||||
;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
|
||||
;; style?
|
||||
(flet ((gnus-article-add-button (&rest args) nil))
|
||||
(let* ((modified (buffer-modified-p))
|
||||
(gnus-article-buffer (buffer-name))
|
||||
(gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
|
||||
,(car gnus-cite-face-list))))
|
||||
(gnus-article-highlight-citation t)
|
||||
(set-buffer-modified-p modified))))
|
||||
|
||||
(provide 'mh-show)
|
||||
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; sentence-end-double-space: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 8607a80a-9b5c-43a7-a25d-d7e4a848c25b
|
||||
;;; mh-show.el ends here
|
||||
|
|
@ -1,6 +1,6 @@
|
|||
;;; mh-speed.el --- Speedbar interface for MH-E.
|
||||
;;; mh-speed.el --- MH-E speedbar support
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
|
|
@ -25,23 +25,21 @@
|
|||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
;; Future versions should only use flists.
|
||||
|
||||
;; Speedbar support for MH-E package.
|
||||
;; Future versions should only use flists.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
;;(message "> mh-speed")
|
||||
(eval-when-compile (require 'mh-acros))
|
||||
(mh-require-cl)
|
||||
(require 'mh-e)
|
||||
(mh-require-cl)
|
||||
|
||||
(require 'gnus-util)
|
||||
(require 'speedbar)
|
||||
(require 'timer)
|
||||
;;(message "< mh-speed")
|
||||
|
||||
;; Global variables
|
||||
;; Global variables.
|
||||
(defvar mh-speed-refresh-flag nil)
|
||||
(defvar mh-speed-last-selected-folder nil)
|
||||
(defvar mh-speed-folder-map (make-hash-table :test #'equal))
|
||||
|
|
@ -50,7 +48,10 @@
|
|||
(defvar mh-speed-flists-timer nil)
|
||||
(defvar mh-speed-partial-line "")
|
||||
|
||||
;; Add our stealth update function
|
||||
|
||||
|
||||
;;; Speedbar Hook
|
||||
|
||||
(unless (member 'mh-speed-stealth-update
|
||||
(cdr (assoc "files" speedbar-stealthy-function-list)))
|
||||
;; Is changing constant lists in elisp safe?
|
||||
|
|
@ -59,7 +60,132 @@
|
|||
(push 'mh-speed-stealth-update
|
||||
(cdr (assoc "files" speedbar-stealthy-function-list))))
|
||||
|
||||
;; Functions called by speedbar to initialize display...
|
||||
|
||||
|
||||
;;; Speedbar Menus
|
||||
|
||||
(defvar mh-folder-speedbar-menu-items
|
||||
'("--"
|
||||
["Visit Folder" mh-speed-view
|
||||
(save-excursion
|
||||
(set-buffer speedbar-buffer)
|
||||
(get-text-property (line-beginning-position) 'mh-folder))]
|
||||
["Expand Nested Folders" mh-speed-expand-folder
|
||||
(and (get-text-property (line-beginning-position) 'mh-children-p)
|
||||
(not (get-text-property (line-beginning-position) 'mh-expanded)))]
|
||||
["Contract Nested Folders" mh-speed-contract-folder
|
||||
(and (get-text-property (line-beginning-position) 'mh-children-p)
|
||||
(get-text-property (line-beginning-position) 'mh-expanded))]
|
||||
["Refresh Speedbar" mh-speed-refresh t])
|
||||
"Extra menu items for speedbar.")
|
||||
|
||||
(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
|
||||
(defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items)
|
||||
|
||||
|
||||
|
||||
;;; Speedbar Keys
|
||||
|
||||
(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
|
||||
"Specialized speedbar keymap for MH-E buffers.")
|
||||
|
||||
(gnus-define-keys mh-folder-speedbar-key-map
|
||||
"+" mh-speed-expand-folder
|
||||
"-" mh-speed-contract-folder
|
||||
"\r" mh-speed-view
|
||||
"r" mh-speed-refresh)
|
||||
|
||||
(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
|
||||
(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
|
||||
|
||||
|
||||
|
||||
;;; Speedbar Commands
|
||||
|
||||
;; Alphabetical.
|
||||
|
||||
(defalias 'mh-speed-contract-folder 'mh-speed-toggle)
|
||||
|
||||
(defalias 'mh-speed-expand-folder 'mh-speed-toggle)
|
||||
|
||||
(defun mh-speed-refresh ()
|
||||
"Regenerates the list of folders in the speedbar.
|
||||
|
||||
Run this command if you've added or deleted a folder, or want to
|
||||
update the unseen message count before the next automatic
|
||||
update."
|
||||
(interactive)
|
||||
(mh-speed-flists t)
|
||||
(mh-speed-invalidate-map ""))
|
||||
|
||||
(defun mh-speed-stealth-update (&optional force)
|
||||
"Do stealth update.
|
||||
With non-nil FORCE, the update is always carried out."
|
||||
(cond ((save-excursion (set-buffer speedbar-buffer)
|
||||
(get-text-property (point-min) 'mh-level))
|
||||
;; Execute this hook and *don't* run anything else
|
||||
(mh-speed-update-current-folder force)
|
||||
nil)
|
||||
;; Otherwise on to your regular programming
|
||||
(t t)))
|
||||
|
||||
(defun mh-speed-toggle (&rest args)
|
||||
"Toggle the display of child folders in the speedbar.
|
||||
The optional ARGS from speedbar are ignored."
|
||||
(interactive)
|
||||
(declare (ignore args))
|
||||
(beginning-of-line)
|
||||
(let ((parent (get-text-property (point) 'mh-folder))
|
||||
(kids-p (get-text-property (point) 'mh-children-p))
|
||||
(expanded (get-text-property (point) 'mh-expanded))
|
||||
(level (get-text-property (point) 'mh-level))
|
||||
(point (point))
|
||||
start-region)
|
||||
(speedbar-with-writable
|
||||
(cond ((not kids-p) nil)
|
||||
(expanded
|
||||
(forward-line)
|
||||
(setq start-region (point))
|
||||
(while (and (get-text-property (point) 'mh-level)
|
||||
(> (get-text-property (point) 'mh-level) level))
|
||||
(let ((folder (get-text-property (point) 'mh-folder)))
|
||||
(when (gethash folder mh-speed-folder-map)
|
||||
(set-marker (gethash folder mh-speed-folder-map) nil)
|
||||
(remhash folder mh-speed-folder-map)))
|
||||
(forward-line))
|
||||
(delete-region start-region (point))
|
||||
(forward-line -1)
|
||||
(speedbar-change-expand-button-char ?+)
|
||||
(add-text-properties
|
||||
(line-beginning-position) (1+ (line-beginning-position))
|
||||
'(mh-expanded nil)))
|
||||
(t
|
||||
(forward-line)
|
||||
(mh-speed-add-buttons parent (1+ level))
|
||||
(goto-char point)
|
||||
(speedbar-change-expand-button-char ?-)
|
||||
(add-text-properties
|
||||
(line-beginning-position) (1+ (line-beginning-position))
|
||||
`(mh-expanded t)))))))
|
||||
|
||||
(defun mh-speed-view (&rest args)
|
||||
"Visits the selected folder just as if you had used \\<mh-folder-mode-map>\\[mh-visit-folder].
|
||||
The optional ARGS from speedbar are ignored."
|
||||
(interactive)
|
||||
(declare (ignore args))
|
||||
(let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
|
||||
(range (and (stringp folder)
|
||||
(mh-read-range "Scan" folder t nil nil
|
||||
mh-interpret-number-as-range-flag))))
|
||||
(when (stringp folder)
|
||||
(speedbar-with-attached-buffer
|
||||
(mh-visit-folder folder range)
|
||||
(delete-other-windows)))))
|
||||
|
||||
|
||||
|
||||
;;; Support Routines
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-folder-speedbar-buttons (buffer)
|
||||
"Interface function to create MH-E speedbar buffer.
|
||||
|
|
@ -86,37 +212,6 @@ created."
|
|||
;;;###mh-autoload
|
||||
(defalias 'mh-letter-speedbar-buttons 'mh-folder-speedbar-buttons)
|
||||
|
||||
;; Keymaps for speedbar...
|
||||
(defvar mh-folder-speedbar-key-map (speedbar-make-specialized-keymap)
|
||||
"Specialized speedbar keymap for MH-E buffers.")
|
||||
(gnus-define-keys mh-folder-speedbar-key-map
|
||||
"+" mh-speed-expand-folder
|
||||
"-" mh-speed-contract-folder
|
||||
"\r" mh-speed-view
|
||||
"r" mh-speed-refresh)
|
||||
|
||||
(defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map)
|
||||
(defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map)
|
||||
|
||||
;; Menus for speedbar...
|
||||
(defvar mh-folder-speedbar-menu-items
|
||||
'("--"
|
||||
["Visit Folder" mh-speed-view
|
||||
(save-excursion
|
||||
(set-buffer speedbar-buffer)
|
||||
(get-text-property (line-beginning-position) 'mh-folder))]
|
||||
["Expand Nested Folders" mh-speed-expand-folder
|
||||
(and (get-text-property (line-beginning-position) 'mh-children-p)
|
||||
(not (get-text-property (line-beginning-position) 'mh-expanded)))]
|
||||
["Contract Nested Folders" mh-speed-contract-folder
|
||||
(and (get-text-property (line-beginning-position) 'mh-children-p)
|
||||
(get-text-property (line-beginning-position) 'mh-expanded))]
|
||||
["Refresh Speedbar" mh-speed-refresh t])
|
||||
"Extra menu items for speedbar.")
|
||||
|
||||
(defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items)
|
||||
(defvar mh-letter-speedbar-menu-items mh-folder-speedbar-menu-items)
|
||||
|
||||
(defmacro mh-speed-select-attached-frame ()
|
||||
"Compatibility macro to handle speedbar versions 0.11a and 0.14beta4."
|
||||
(cond ((fboundp 'dframe-select-attached-frame)
|
||||
|
|
@ -167,6 +262,19 @@ The update is always carried out if FORCE is non-nil."
|
|||
(when (eq lastf speedbar-frame)
|
||||
(setq mh-speed-refresh-flag t))))
|
||||
|
||||
(defun mh-speed-highlight (folder face)
|
||||
"Set FOLDER to FACE."
|
||||
(save-excursion
|
||||
(speedbar-with-writable
|
||||
(goto-char (gethash folder mh-speed-folder-map (point)))
|
||||
(beginning-of-line)
|
||||
(if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t)
|
||||
(setq face (mh-speed-bold-face face))
|
||||
(setq face (mh-speed-normal-face face)))
|
||||
(beginning-of-line)
|
||||
(when (re-search-forward "\\[.\\] " (line-end-position) t)
|
||||
(put-text-property (point) (line-end-position) 'face face)))))
|
||||
|
||||
(defun mh-speed-normal-face (face)
|
||||
"Return normal face for given FACE."
|
||||
(cond ((eq face 'mh-speedbar-folder-with-unseen-messages)
|
||||
|
|
@ -183,30 +291,6 @@ The update is always carried out if FORCE is non-nil."
|
|||
'mh-speedbar-selected-folder-with-unseen-messages)
|
||||
(t face)))
|
||||
|
||||
(defun mh-speed-highlight (folder face)
|
||||
"Set FOLDER to FACE."
|
||||
(save-excursion
|
||||
(speedbar-with-writable
|
||||
(goto-char (gethash folder mh-speed-folder-map (point)))
|
||||
(beginning-of-line)
|
||||
(if (re-search-forward "([1-9][0-9]*/[0-9]+)" (line-end-position) t)
|
||||
(setq face (mh-speed-bold-face face))
|
||||
(setq face (mh-speed-normal-face face)))
|
||||
(beginning-of-line)
|
||||
(when (re-search-forward "\\[.\\] " (line-end-position) t)
|
||||
(put-text-property (point) (line-end-position) 'face face)))))
|
||||
|
||||
(defun mh-speed-stealth-update (&optional force)
|
||||
"Do stealth update.
|
||||
With non-nil FORCE, the update is always carried out."
|
||||
(cond ((save-excursion (set-buffer speedbar-buffer)
|
||||
(get-text-property (point-min) 'mh-level))
|
||||
;; Execute this hook and *don't* run anything else
|
||||
(mh-speed-update-current-folder force)
|
||||
nil)
|
||||
;; Otherwise on to your regular programming
|
||||
(t t)))
|
||||
|
||||
(defun mh-speed-goto-folder (folder)
|
||||
"Move point to line containing FOLDER.
|
||||
The function will expand out parent folders of FOLDER if needed."
|
||||
|
|
@ -295,64 +379,6 @@ uses."
|
|||
mh-level ,level))))))
|
||||
folder-list)))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-toggle (&rest args)
|
||||
"Toggle the display of child folders in the speedbar.
|
||||
The optional ARGS from speedbar are ignored."
|
||||
(interactive)
|
||||
(declare (ignore args))
|
||||
(beginning-of-line)
|
||||
(let ((parent (get-text-property (point) 'mh-folder))
|
||||
(kids-p (get-text-property (point) 'mh-children-p))
|
||||
(expanded (get-text-property (point) 'mh-expanded))
|
||||
(level (get-text-property (point) 'mh-level))
|
||||
(point (point))
|
||||
start-region)
|
||||
(speedbar-with-writable
|
||||
(cond ((not kids-p) nil)
|
||||
(expanded
|
||||
(forward-line)
|
||||
(setq start-region (point))
|
||||
(while (and (get-text-property (point) 'mh-level)
|
||||
(> (get-text-property (point) 'mh-level) level))
|
||||
(let ((folder (get-text-property (point) 'mh-folder)))
|
||||
(when (gethash folder mh-speed-folder-map)
|
||||
(set-marker (gethash folder mh-speed-folder-map) nil)
|
||||
(remhash folder mh-speed-folder-map)))
|
||||
(forward-line))
|
||||
(delete-region start-region (point))
|
||||
(forward-line -1)
|
||||
(speedbar-change-expand-button-char ?+)
|
||||
(add-text-properties
|
||||
(line-beginning-position) (1+ (line-beginning-position))
|
||||
'(mh-expanded nil)))
|
||||
(t
|
||||
(forward-line)
|
||||
(mh-speed-add-buttons parent (1+ level))
|
||||
(goto-char point)
|
||||
(speedbar-change-expand-button-char ?-)
|
||||
(add-text-properties
|
||||
(line-beginning-position) (1+ (line-beginning-position))
|
||||
`(mh-expanded t)))))))
|
||||
|
||||
(defalias 'mh-speed-expand-folder 'mh-speed-toggle)
|
||||
(defalias 'mh-speed-contract-folder 'mh-speed-toggle)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-view (&rest args)
|
||||
"Visits the selected folder just as if you had used \\<mh-folder-mode-map>\\[mh-visit-folder].
|
||||
The optional ARGS from speedbar are ignored."
|
||||
(interactive)
|
||||
(declare (ignore args))
|
||||
(let* ((folder (get-text-property (line-beginning-position) 'mh-folder))
|
||||
(range (and (stringp folder)
|
||||
(mh-read-range "Scan" folder t nil nil
|
||||
mh-interpret-number-as-range-flag))))
|
||||
(when (stringp folder)
|
||||
(speedbar-with-attached-buffer
|
||||
(mh-visit-folder folder range)
|
||||
(delete-other-windows)))))
|
||||
|
||||
(defvar mh-speed-current-folder nil)
|
||||
(defvar mh-speed-flists-folder nil)
|
||||
|
||||
|
|
@ -415,6 +441,7 @@ flists is run only for that one folder."
|
|||
'mh-speed-parse-flists-output)))))))
|
||||
|
||||
;; Copied from mh-make-folder-list-filter...
|
||||
;; XXX Refactor to use mh-make-folder-list-filer?
|
||||
(defun mh-speed-parse-flists-output (process output)
|
||||
"Parse the incremental results from flists.
|
||||
PROCESS is the flists process and OUTPUT is the results that must
|
||||
|
|
@ -506,17 +533,23 @@ be handled next."
|
|||
(setq mh-speed-last-selected-folder nil)
|
||||
(setq mh-speed-refresh-flag t)))
|
||||
(when (equal folder "")
|
||||
(clrhash mh-sub-folders-cache)))))
|
||||
(mh-clear-sub-folders-cache)))))
|
||||
|
||||
(defun mh-speed-refresh ()
|
||||
"Regenerates the list of folders in the speedbar.
|
||||
|
||||
Run this command if you've added or deleted a folder, or want to
|
||||
update the unseen message count before the next automatic
|
||||
update."
|
||||
(interactive)
|
||||
(mh-speed-flists t)
|
||||
(mh-speed-invalidate-map ""))
|
||||
;; Make it slightly more general to allow for [ ] buttons to be
|
||||
;; changed to [+].
|
||||
(defun mh-speedbar-change-expand-button-char (char)
|
||||
"Change the expansion button character to CHAR for the current line."
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (re-search-forward "\\[.\\]" (line-end-position) t)
|
||||
(speedbar-with-writable
|
||||
(backward-char 2)
|
||||
(delete-char 1)
|
||||
(insert-char char 1 t)
|
||||
(put-text-property (point) (1- (point)) 'invisible nil)
|
||||
;; make sure we fix the image on the text here.
|
||||
(mh-funcall-if-exists
|
||||
speedbar-insert-image-button-maybe (- (point) 2) 3)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-speed-add-folder (folder)
|
||||
|
|
@ -546,22 +579,6 @@ The function invalidates the latest ancestor that is present."
|
|||
(mh-speed-toggle))
|
||||
(setq mh-speed-refresh-flag t))))
|
||||
|
||||
;; Make it slightly more general to allow for [ ] buttons to be changed to
|
||||
;; [+].
|
||||
(defun mh-speedbar-change-expand-button-char (char)
|
||||
"Change the expansion button character to CHAR for the current line."
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (re-search-forward "\\[.\\]" (line-end-position) t)
|
||||
(speedbar-with-writable
|
||||
(backward-char 2)
|
||||
(delete-char 1)
|
||||
(insert-char char 1 t)
|
||||
(put-text-property (point) (1- (point)) 'invisible nil)
|
||||
;; make sure we fix the image on the text here.
|
||||
(mh-funcall-if-exists
|
||||
speedbar-insert-image-button-maybe (- (point) 2) 3)))))
|
||||
|
||||
(provide 'mh-speed)
|
||||
|
||||
;; Local Variables:
|
||||
|
|
|
|||
884
lisp/mh-e/mh-thread.el
Normal file
884
lisp/mh-e/mh-thread.el
Normal file
|
|
@ -0,0 +1,884 @@
|
|||
;;; mh-thread.el --- MH-E threading support
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;; The threading portion of this files tries to implement the
|
||||
;; algorithm described at:
|
||||
;; http://www.jwz.org/doc/threading.html
|
||||
;; It also begins to implement the IMAP Threading extension RFC. The
|
||||
;; implementation lacks the reference and subject canonicalization of
|
||||
;; the RFC.
|
||||
|
||||
;; In the presentation buffer, children messages are shown indented
|
||||
;; with either [ ] or < > around them. Square brackets ([ ]) denote
|
||||
;; that the algorithm can point out some headers which when taken
|
||||
;; together implies that the unindented message is an ancestor of the
|
||||
;; indented message. If no such proof exists then angles (< >) are
|
||||
;; used.
|
||||
|
||||
;; If threading is slow on your machine, compile this file. Of all the
|
||||
;; files in MH-E, this one really benefits from compilation.
|
||||
|
||||
;; Some issues and problems are as follows:
|
||||
|
||||
;; (1) Scan truncates the fields at length 512. So longer
|
||||
;; references: headers get mutilated. The same kind of MH
|
||||
;; format string works when composing messages. Is there a way
|
||||
;; to avoid this? My scan command is as follows:
|
||||
;; scan +folder -width 10000 \
|
||||
;; -format "%(msg)\n%{message-id}\n%{references}\n%{subject}\n"
|
||||
;; I would really appreciate it if someone would help me with this.
|
||||
|
||||
;; (2) Implement heuristics to recognize message identifiers in
|
||||
;; In-Reply-To: header. Right now it just assumes that the last
|
||||
;; text between angles (< and >) is the message identifier.
|
||||
;; There is the chance that this will incorrectly use an email
|
||||
;; address like a message identifier.
|
||||
|
||||
;; (3) Error checking of found message identifiers should be done.
|
||||
|
||||
;; (4) Since this breaks the assumption that message indices
|
||||
;; increase as one goes down the buffer, the binary search
|
||||
;; based mh-goto-msg doesn't work. I have a simpler replacement
|
||||
;; which may be less efficient.
|
||||
|
||||
;; (5) Better canonicalizing for message identifier and subject
|
||||
;; strings.
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mh-e)
|
||||
(require 'mh-scan)
|
||||
|
||||
(mh-defstruct (mh-thread-message (:conc-name mh-message-)
|
||||
(:constructor mh-thread-make-message))
|
||||
(id nil)
|
||||
(references ())
|
||||
(subject "")
|
||||
(subject-re-p nil))
|
||||
|
||||
(mh-defstruct (mh-thread-container (:conc-name mh-container-)
|
||||
(:constructor mh-thread-make-container))
|
||||
message parent children
|
||||
(real-child-p t))
|
||||
|
||||
(defvar mh-thread-id-hash nil
|
||||
"Hashtable used to canonicalize message identifiers.")
|
||||
(make-variable-buffer-local 'mh-thread-id-hash)
|
||||
|
||||
(defvar mh-thread-subject-hash nil
|
||||
"Hashtable used to canonicalize subject strings.")
|
||||
(make-variable-buffer-local 'mh-thread-subject-hash)
|
||||
|
||||
(defvar mh-thread-id-table nil
|
||||
"Thread ID table maps from message identifiers to message containers.")
|
||||
(make-variable-buffer-local 'mh-thread-id-table)
|
||||
|
||||
(defvar mh-thread-index-id-map nil
|
||||
"Table to look up message identifier from message index.")
|
||||
(make-variable-buffer-local 'mh-thread-index-id-map)
|
||||
|
||||
(defvar mh-thread-id-index-map nil
|
||||
"Table to look up message index number from message identifier.")
|
||||
(make-variable-buffer-local 'mh-thread-id-index-map)
|
||||
|
||||
(defvar mh-thread-subject-container-hash nil
|
||||
"Hashtable used to group messages by subject.")
|
||||
(make-variable-buffer-local 'mh-thread-subject-container-hash)
|
||||
|
||||
(defvar mh-thread-duplicates nil
|
||||
"Hashtable used to associate messages with the same message identifier.")
|
||||
(make-variable-buffer-local 'mh-thread-duplicates)
|
||||
|
||||
(defvar mh-thread-history ()
|
||||
"Variable to remember the transformations to the thread tree.
|
||||
When new messages are added, these transformations are rewound,
|
||||
then the links are added from the newly seen messages. Finally
|
||||
the transformations are redone to get the new thread tree. This
|
||||
makes incremental threading easier.")
|
||||
(make-variable-buffer-local 'mh-thread-history)
|
||||
|
||||
(defvar mh-thread-body-width nil
|
||||
"Width of scan substring that contains subject and body of message.")
|
||||
|
||||
|
||||
|
||||
;;; MH-Folder Commands
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-ancestor (&optional thread-root-flag)
|
||||
"Display ancestor of current message.
|
||||
|
||||
If you do not care for the way a particular thread has turned,
|
||||
you can move up the chain of messages with this command. This
|
||||
command can also take a prefix argument THREAD-ROOT-FLAG to jump
|
||||
to the message that started everything."
|
||||
(interactive "P")
|
||||
(beginning-of-line)
|
||||
(cond ((not (memq 'unthread mh-view-ops))
|
||||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point")))
|
||||
(let ((current-level (mh-thread-current-indentation-level)))
|
||||
(cond (thread-root-flag
|
||||
(while (mh-thread-immediate-ancestor))
|
||||
(mh-maybe-show))
|
||||
((equal current-level 1)
|
||||
(message "Message has no ancestor"))
|
||||
(t (mh-thread-immediate-ancestor)
|
||||
(mh-maybe-show)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-delete ()
|
||||
"Delete thread."
|
||||
(interactive)
|
||||
(cond ((not (memq 'unthread mh-view-ops))
|
||||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point"))
|
||||
(t (let ((region (mh-thread-find-children)))
|
||||
(mh-iterate-on-messages-in-region () (car region) (cadr region)
|
||||
(mh-delete-a-msg nil))
|
||||
(mh-next-msg)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-next-sibling (&optional previous-flag)
|
||||
"Display next sibling.
|
||||
|
||||
With non-nil optional argument PREVIOUS-FLAG jump to the previous
|
||||
sibling."
|
||||
(interactive)
|
||||
(cond ((not (memq 'unthread mh-view-ops))
|
||||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point")))
|
||||
(beginning-of-line)
|
||||
(let ((point (point))
|
||||
(done nil)
|
||||
(my-level (mh-thread-current-indentation-level)))
|
||||
(while (and (not done)
|
||||
(equal (forward-line (if previous-flag -1 1)) 0)
|
||||
(not (eobp)))
|
||||
(let ((level (mh-thread-current-indentation-level)))
|
||||
(cond ((equal level my-level)
|
||||
(setq done 'success))
|
||||
((< level my-level)
|
||||
(message "No %s sibling" (if previous-flag "previous" "next"))
|
||||
(setq done 'failure)))))
|
||||
(cond ((eq done 'success) (mh-maybe-show))
|
||||
((eq done 'failure) (goto-char point))
|
||||
(t (message "No %s sibling" (if previous-flag "previous" "next"))
|
||||
(goto-char point)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-previous-sibling ()
|
||||
"Display previous sibling."
|
||||
(interactive)
|
||||
(mh-thread-next-sibling t))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-refile (folder)
|
||||
"Refile (output) thread into FOLDER."
|
||||
(interactive (list (intern (mh-prompt-for-refile-folder))))
|
||||
(cond ((not (memq 'unthread mh-view-ops))
|
||||
(error "Folder isn't threaded"))
|
||||
((eobp)
|
||||
(error "No message at point"))
|
||||
(t (let ((region (mh-thread-find-children)))
|
||||
(mh-iterate-on-messages-in-region () (car region) (cadr region)
|
||||
(mh-refile-a-msg nil folder))
|
||||
(mh-next-msg)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-toggle-threads ()
|
||||
"Toggle threaded view of folder."
|
||||
(interactive)
|
||||
(let ((msg-at-point (mh-get-msg-num nil))
|
||||
(old-buffer-modified-flag (buffer-modified-p))
|
||||
(buffer-read-only nil))
|
||||
(cond ((memq 'unthread mh-view-ops)
|
||||
(unless (mh-valid-view-change-operation-p 'unthread)
|
||||
(error "Can't unthread folder"))
|
||||
(let ((msg-list ()))
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(let ((index (mh-get-msg-num nil)))
|
||||
(when index
|
||||
(push index msg-list)))
|
||||
(forward-line))
|
||||
(mh-scan-folder mh-current-folder
|
||||
(mapcar #'(lambda (x) (format "%s" x))
|
||||
(mh-coalesce-msg-list msg-list))
|
||||
t))
|
||||
(when mh-index-data
|
||||
(mh-index-insert-folder-headers)
|
||||
(mh-notate-cur)))
|
||||
(t (mh-thread-folder)
|
||||
(push 'unthread mh-view-ops)))
|
||||
(when msg-at-point (mh-goto-msg msg-at-point t t))
|
||||
(set-buffer-modified-p old-buffer-modified-flag)
|
||||
(mh-recenter nil)))
|
||||
|
||||
|
||||
|
||||
;;; Support Routines
|
||||
|
||||
(defun mh-thread-current-indentation-level ()
|
||||
"Find the number of spaces by which current message is indented."
|
||||
(save-excursion
|
||||
(let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
|
||||
mh-scan-date-width 1))
|
||||
(level 0))
|
||||
(beginning-of-line)
|
||||
(forward-char address-start-offset)
|
||||
(while (char-equal (char-after) ? )
|
||||
(incf level)
|
||||
(forward-char))
|
||||
level)))
|
||||
|
||||
(defun mh-thread-immediate-ancestor ()
|
||||
"Jump to immediate ancestor in thread tree."
|
||||
(beginning-of-line)
|
||||
(let ((point (point))
|
||||
(ancestor-level (- (mh-thread-current-indentation-level) 2))
|
||||
(done nil))
|
||||
(if (< ancestor-level 0)
|
||||
nil
|
||||
(while (and (not done) (equal (forward-line -1) 0))
|
||||
(when (equal ancestor-level (mh-thread-current-indentation-level))
|
||||
(setq done t)))
|
||||
(unless done
|
||||
(goto-char point))
|
||||
done)))
|
||||
|
||||
(defun mh-thread-find-children ()
|
||||
"Return a region containing the current message and its children.
|
||||
The result is returned as a list of two elements. The first is
|
||||
the point at the start of the region and the second is the point
|
||||
at the end."
|
||||
(beginning-of-line)
|
||||
(if (eobp)
|
||||
nil
|
||||
(let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
|
||||
mh-scan-date-width 1))
|
||||
(level (mh-thread-current-indentation-level))
|
||||
spaces begin)
|
||||
(setq begin (point))
|
||||
(setq spaces (format (format "%%%ss" (1+ level)) ""))
|
||||
(forward-line)
|
||||
(block nil
|
||||
(while (not (eobp))
|
||||
(forward-char address-start-offset)
|
||||
(unless (equal (string-match spaces (buffer-substring-no-properties
|
||||
(point) (line-end-position)))
|
||||
0)
|
||||
(beginning-of-line)
|
||||
(backward-char)
|
||||
(return))
|
||||
(forward-line)))
|
||||
(list begin (point)))))
|
||||
|
||||
|
||||
|
||||
;;; Thread Creation
|
||||
|
||||
(defun mh-thread-folder ()
|
||||
"Generate thread view of folder."
|
||||
(message "Threading %s..." (buffer-name))
|
||||
(mh-thread-initialize)
|
||||
(goto-char (point-min))
|
||||
(mh-remove-all-notation)
|
||||
(let ((msg-list ()))
|
||||
(mh-iterate-on-range msg (cons (point-min) (point-max))
|
||||
(setf (gethash msg mh-thread-scan-line-map) (mh-thread-parse-scan-line))
|
||||
(push msg msg-list))
|
||||
(let* ((range (mh-coalesce-msg-list msg-list))
|
||||
(thread-tree (mh-thread-generate (buffer-name) range)))
|
||||
(delete-region (point-min) (point-max))
|
||||
(mh-thread-print-scan-lines thread-tree)
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-cur)
|
||||
(message "Threading %s...done" (buffer-name)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-inc (folder start-point)
|
||||
"Update thread tree for FOLDER.
|
||||
All messages after START-POINT are added to the thread tree."
|
||||
(mh-thread-rewind-pruning)
|
||||
(mh-remove-all-notation)
|
||||
(goto-char start-point)
|
||||
(let ((msg-list ()))
|
||||
(while (not (eobp))
|
||||
(let ((index (mh-get-msg-num nil)))
|
||||
(when (numberp index)
|
||||
(push index msg-list)
|
||||
(setf (gethash index mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line)))
|
||||
(forward-line)))
|
||||
(let ((thread-tree (mh-thread-generate folder msg-list))
|
||||
(buffer-read-only nil)
|
||||
(old-buffer-modified-flag (buffer-modified-p)))
|
||||
(delete-region (point-min) (point-max))
|
||||
(mh-thread-print-scan-lines thread-tree)
|
||||
(mh-notate-user-sequences)
|
||||
(mh-notate-deleted-and-refiled)
|
||||
(mh-notate-cur)
|
||||
(set-buffer-modified-p old-buffer-modified-flag))))
|
||||
|
||||
(defmacro mh-thread-initialize-hash (var test)
|
||||
"Initialize the hash table in VAR.
|
||||
TEST is the test to use when creating a new hash table."
|
||||
(unless (symbolp var) (error "Expected a symbol: %s" var))
|
||||
`(if ,var (clrhash ,var) (setq ,var (make-hash-table :test ,test))))
|
||||
|
||||
(defun mh-thread-initialize ()
|
||||
"Make new hash tables, or clear them if already present."
|
||||
(mh-thread-initialize-hash mh-thread-id-hash #'equal)
|
||||
(mh-thread-initialize-hash mh-thread-subject-hash #'equal)
|
||||
(mh-thread-initialize-hash mh-thread-id-table #'eq)
|
||||
(mh-thread-initialize-hash mh-thread-id-index-map #'eq)
|
||||
(mh-thread-initialize-hash mh-thread-index-id-map #'eql)
|
||||
(mh-thread-initialize-hash mh-thread-scan-line-map #'eql)
|
||||
(mh-thread-initialize-hash mh-thread-subject-container-hash #'eq)
|
||||
(mh-thread-initialize-hash mh-thread-duplicates #'eq)
|
||||
(setq mh-thread-history ()))
|
||||
|
||||
(defsubst mh-thread-id-container (id)
|
||||
"Given ID, return the corresponding container in `mh-thread-id-table'.
|
||||
If no container exists then a suitable container is created and
|
||||
the id-table is updated."
|
||||
(when (not id)
|
||||
(error "1"))
|
||||
(or (gethash id mh-thread-id-table)
|
||||
(setf (gethash id mh-thread-id-table)
|
||||
(let ((message (mh-thread-make-message :id id)))
|
||||
(mh-thread-make-container :message message)))))
|
||||
|
||||
(defsubst mh-thread-remove-parent-link (child)
|
||||
"Remove parent link of CHILD if it exists."
|
||||
(let* ((child-container (if (mh-thread-container-p child)
|
||||
child (mh-thread-id-container child)))
|
||||
(parent-container (mh-container-parent child-container)))
|
||||
(when parent-container
|
||||
(setf (mh-container-children parent-container)
|
||||
(loop for elem in (mh-container-children parent-container)
|
||||
unless (eq child-container elem) collect elem))
|
||||
(setf (mh-container-parent child-container) nil))))
|
||||
|
||||
(defsubst mh-thread-add-link (parent child &optional at-end-p)
|
||||
"Add links so that PARENT becomes a parent of CHILD.
|
||||
Doesn't make any changes if CHILD is already an ancestor of
|
||||
PARENT. If optional argument AT-END-P is non-nil, the CHILD is
|
||||
added to the end of the children list of PARENT."
|
||||
(let ((parent-container (cond ((null parent) nil)
|
||||
((mh-thread-container-p parent) parent)
|
||||
(t (mh-thread-id-container parent))))
|
||||
(child-container (if (mh-thread-container-p child)
|
||||
child (mh-thread-id-container child))))
|
||||
(when (and parent-container
|
||||
(not (mh-thread-ancestor-p child-container parent-container))
|
||||
(not (mh-thread-ancestor-p parent-container child-container)))
|
||||
(mh-thread-remove-parent-link child-container)
|
||||
(cond ((not at-end-p)
|
||||
(push child-container (mh-container-children parent-container)))
|
||||
((null (mh-container-children parent-container))
|
||||
(push child-container (mh-container-children parent-container)))
|
||||
(t (let ((last-child (mh-container-children parent-container)))
|
||||
(while (cdr last-child)
|
||||
(setq last-child (cdr last-child)))
|
||||
(setcdr last-child (cons child-container nil)))))
|
||||
(setf (mh-container-parent child-container) parent-container))
|
||||
(unless parent-container
|
||||
(mh-thread-remove-parent-link child-container))))
|
||||
|
||||
(defun mh-thread-rewind-pruning ()
|
||||
"Restore the thread tree to its state before pruning."
|
||||
(while mh-thread-history
|
||||
(let ((action (pop mh-thread-history)))
|
||||
(cond ((eq (car action) 'DROP)
|
||||
(mh-thread-remove-parent-link (cadr action))
|
||||
(mh-thread-add-link (caddr action) (cadr action)))
|
||||
((eq (car action) 'PROMOTE)
|
||||
(let ((node (cadr action))
|
||||
(parent (caddr action))
|
||||
(children (cdddr action)))
|
||||
(dolist (child children)
|
||||
(mh-thread-remove-parent-link child)
|
||||
(mh-thread-add-link node child))
|
||||
(mh-thread-add-link parent node)))
|
||||
((eq (car action) 'SUBJECT)
|
||||
(let ((node (cadr action)))
|
||||
(mh-thread-remove-parent-link node)
|
||||
(setf (mh-container-real-child-p node) t)))))))
|
||||
|
||||
(defun mh-thread-ancestor-p (ancestor successor)
|
||||
"Return t if ANCESTOR is really an ancestor of SUCCESSOR and nil otherwise.
|
||||
In the limit, the function returns t if ANCESTOR and SUCCESSOR
|
||||
are the same containers."
|
||||
(block nil
|
||||
(while successor
|
||||
(when (eq ancestor successor) (return t))
|
||||
(setq successor (mh-container-parent successor)))
|
||||
nil))
|
||||
|
||||
;; Another and may be better approach would be to generate all the info from
|
||||
;; the scan which generates the threading info. For now this will have to do.
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-parse-scan-line (&optional string)
|
||||
"Parse a scan line.
|
||||
If optional argument STRING is given then that is assumed to be
|
||||
the scan line. Otherwise uses the line at point as the scan line
|
||||
to parse."
|
||||
(let* ((string (or string
|
||||
(buffer-substring-no-properties (line-beginning-position)
|
||||
(line-end-position))))
|
||||
(address-start (+ mh-cmd-note mh-scan-field-from-start-offset))
|
||||
(body-start (+ mh-cmd-note mh-scan-field-from-end-offset))
|
||||
(first-string (substring string 0 address-start)))
|
||||
(list first-string
|
||||
(substring string address-start (- body-start 2))
|
||||
(substring string body-start)
|
||||
string)))
|
||||
|
||||
(defsubst mh-thread-canonicalize-id (id)
|
||||
"Produce canonical string representation for ID.
|
||||
This allows cheap string comparison with EQ."
|
||||
(or (and (equal id "") (copy-sequence ""))
|
||||
(gethash id mh-thread-id-hash)
|
||||
(setf (gethash id mh-thread-id-hash) id)))
|
||||
|
||||
(defsubst mh-thread-prune-subject (subject)
|
||||
"Prune leading Re:'s, Fwd:'s etc. and trailing (fwd)'s from SUBJECT.
|
||||
If the result after pruning is not the empty string then it is
|
||||
canonicalized so that subjects can be tested for equality with
|
||||
eq. This is done so that all the messages without a subject are
|
||||
not put into a single thread."
|
||||
(let ((case-fold-search t)
|
||||
(subject-pruned-flag nil))
|
||||
;; Prune subject leader
|
||||
(while (or (string-match "^[ \t]*\\(re\\|fwd?\\)\\(\\[[0-9]*\\]\\)?:[ \t]*"
|
||||
subject)
|
||||
(string-match "^[ \t]*\\[[^\\]][ \t]*" subject))
|
||||
(setq subject-pruned-flag t)
|
||||
(setq subject (substring subject (match-end 0))))
|
||||
;; Prune subject trailer
|
||||
(while (or (string-match "(fwd)$" subject)
|
||||
(string-match "[ \t]+$" subject))
|
||||
(setq subject-pruned-flag t)
|
||||
(setq subject (substring subject 0 (match-beginning 0))))
|
||||
;; Canonicalize subject only if it is non-empty
|
||||
(cond ((equal subject "") (values subject subject-pruned-flag))
|
||||
(t (values
|
||||
(or (gethash subject mh-thread-subject-hash)
|
||||
(setf (gethash subject mh-thread-subject-hash) subject))
|
||||
subject-pruned-flag)))))
|
||||
|
||||
(defsubst mh-thread-group-by-subject (roots)
|
||||
"Group the set of message containers, ROOTS based on subject.
|
||||
Bug: Check for and make sure that something without Re: is made
|
||||
the parent in preference to something that has it."
|
||||
(clrhash mh-thread-subject-container-hash)
|
||||
(let ((results ()))
|
||||
(dolist (root roots)
|
||||
(let* ((subject (mh-thread-container-subject root))
|
||||
(parent (gethash subject mh-thread-subject-container-hash)))
|
||||
(cond (parent (mh-thread-remove-parent-link root)
|
||||
(mh-thread-add-link parent root t)
|
||||
(setf (mh-container-real-child-p root) nil)
|
||||
(push `(SUBJECT ,root) mh-thread-history))
|
||||
(t
|
||||
(setf (gethash subject mh-thread-subject-container-hash) root)
|
||||
(push root results)))))
|
||||
(nreverse results)))
|
||||
|
||||
(defun mh-thread-container-subject (container)
|
||||
"Return the subject of CONTAINER.
|
||||
If CONTAINER is empty return the subject info of one of its
|
||||
children."
|
||||
(cond ((and (mh-container-message container)
|
||||
(mh-message-id (mh-container-message container)))
|
||||
(mh-message-subject (mh-container-message container)))
|
||||
(t (block nil
|
||||
(dolist (kid (mh-container-children container))
|
||||
(when (and (mh-container-message kid)
|
||||
(mh-message-id (mh-container-message kid)))
|
||||
(let ((kid-message (mh-container-message kid)))
|
||||
(return (mh-message-subject kid-message)))))
|
||||
(error "This can't happen")))))
|
||||
|
||||
(defsubst mh-thread-update-id-index-maps (id index)
|
||||
"Message with id, ID is the message in INDEX.
|
||||
The function also checks for duplicate messages (that is multiple
|
||||
messages with the same ID). These messages are put in the
|
||||
`mh-thread-duplicates' hash table."
|
||||
(let ((old-index (gethash id mh-thread-id-index-map)))
|
||||
(when old-index (push old-index (gethash id mh-thread-duplicates)))
|
||||
(setf (gethash id mh-thread-id-index-map) index)
|
||||
(setf (gethash index mh-thread-index-id-map) id)))
|
||||
|
||||
(defsubst mh-thread-get-message-container (message)
|
||||
"Return container which has MESSAGE in it.
|
||||
If there is no container present then a new container is
|
||||
allocated."
|
||||
(let* ((id (mh-message-id message))
|
||||
(container (gethash id mh-thread-id-table)))
|
||||
(cond (container (setf (mh-container-message container) message)
|
||||
container)
|
||||
(t (setf (gethash id mh-thread-id-table)
|
||||
(mh-thread-make-container :message message))))))
|
||||
|
||||
(defsubst mh-thread-get-message (id subject-re-p subject refs)
|
||||
"Return appropriate message.
|
||||
Otherwise update message already present to have the proper ID,
|
||||
SUBJECT-RE-P, SUBJECT and REFS fields."
|
||||
(let* ((container (gethash id mh-thread-id-table))
|
||||
(message (if container (mh-container-message container) nil)))
|
||||
(cond (message
|
||||
(setf (mh-message-subject-re-p message) subject-re-p)
|
||||
(setf (mh-message-subject message) subject)
|
||||
(setf (mh-message-id message) id)
|
||||
(setf (mh-message-references message) refs)
|
||||
message)
|
||||
(container
|
||||
(setf (mh-container-message container)
|
||||
(mh-thread-make-message :id id :references refs
|
||||
:subject subject
|
||||
:subject-re-p subject-re-p)))
|
||||
(t (let ((message (mh-thread-make-message :id id :references refs
|
||||
:subject-re-p subject-re-p
|
||||
:subject subject)))
|
||||
(prog1 message
|
||||
(mh-thread-get-message-container message)))))))
|
||||
|
||||
(defvar mh-message-id-regexp "^<.*@.*>$"
|
||||
"Regexp to recognize whether a string is a message identifier.")
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-generate (folder msg-list)
|
||||
"Scan FOLDER to get info for threading.
|
||||
Only information about messages in MSG-LIST are added to the tree."
|
||||
(with-temp-buffer
|
||||
(mh-thread-set-tables folder)
|
||||
(when msg-list
|
||||
(apply
|
||||
#'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
|
||||
"-width" "10000" "-format"
|
||||
"%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
|
||||
folder (mapcar #'(lambda (x) (format "%s" x)) msg-list)))
|
||||
(goto-char (point-min))
|
||||
(let ((roots ())
|
||||
(case-fold-search t))
|
||||
(block nil
|
||||
(while (not (eobp))
|
||||
(block process-message
|
||||
(let* ((index-line
|
||||
(prog1 (buffer-substring (point) (line-end-position))
|
||||
(forward-line)))
|
||||
(index (string-to-number index-line))
|
||||
(id (prog1 (buffer-substring (point) (line-end-position))
|
||||
(forward-line)))
|
||||
(refs (prog1 (buffer-substring (point) (line-end-position))
|
||||
(forward-line)))
|
||||
(in-reply-to (prog1 (buffer-substring (point)
|
||||
(line-end-position))
|
||||
(forward-line)))
|
||||
(subject (prog1
|
||||
(buffer-substring (point) (line-end-position))
|
||||
(forward-line)))
|
||||
(subject-re-p nil))
|
||||
(unless (gethash index mh-thread-scan-line-map)
|
||||
(return-from process-message))
|
||||
(unless (integerp index) (return)) ;Error message here
|
||||
(multiple-value-setq (subject subject-re-p)
|
||||
(mh-thread-prune-subject subject))
|
||||
(setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
|
||||
(setq refs (loop for x in (append (split-string refs) in-reply-to)
|
||||
when (string-match mh-message-id-regexp x)
|
||||
collect x))
|
||||
(setq id (mh-thread-canonicalize-id id))
|
||||
(mh-thread-update-id-index-maps id index)
|
||||
(setq refs (mapcar #'mh-thread-canonicalize-id refs))
|
||||
(mh-thread-get-message id subject-re-p subject refs)
|
||||
(do ((ancestors refs (cdr ancestors)))
|
||||
((null (cdr ancestors))
|
||||
(when (car ancestors)
|
||||
(mh-thread-remove-parent-link id)
|
||||
(mh-thread-add-link (car ancestors) id)))
|
||||
(mh-thread-add-link (car ancestors) (cadr ancestors)))))))
|
||||
(maphash #'(lambda (k v)
|
||||
(declare (ignore k))
|
||||
(when (null (mh-container-parent v))
|
||||
(push v roots)))
|
||||
mh-thread-id-table)
|
||||
(setq roots (mh-thread-prune-containers roots))
|
||||
(prog1 (setq roots (mh-thread-group-by-subject roots))
|
||||
(let ((history mh-thread-history))
|
||||
(set-buffer folder)
|
||||
(setq mh-thread-history history))))))
|
||||
|
||||
(defun mh-thread-set-tables (folder)
|
||||
"Use the tables of FOLDER in current buffer."
|
||||
(flet ((mh-get-table (symbol)
|
||||
(save-excursion
|
||||
(set-buffer folder)
|
||||
(symbol-value symbol))))
|
||||
(setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
|
||||
(setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
|
||||
(setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
|
||||
(setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map))
|
||||
(setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map))
|
||||
(setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map))
|
||||
(setq mh-thread-subject-container-hash
|
||||
(mh-get-table 'mh-thread-subject-container-hash))
|
||||
(setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates))
|
||||
(setq mh-thread-history (mh-get-table 'mh-thread-history))))
|
||||
|
||||
(defun mh-thread-process-in-reply-to (reply-to-header)
|
||||
"Extract message id's from REPLY-TO-HEADER.
|
||||
Ideally this should have some regexp which will try to guess if a
|
||||
string between < and > is a message id and not an email address.
|
||||
For now it will take the last string inside angles."
|
||||
(let ((end (mh-search-from-end ?> reply-to-header)))
|
||||
(when (numberp end)
|
||||
(let ((begin (mh-search-from-end ?< (substring reply-to-header 0 end))))
|
||||
(when (numberp begin)
|
||||
(list (substring reply-to-header begin (1+ end))))))))
|
||||
|
||||
(defun mh-thread-prune-containers (roots)
|
||||
"Prune empty containers in the containers ROOTS."
|
||||
(let ((dfs-ordered-nodes ())
|
||||
(work-list roots))
|
||||
(while work-list
|
||||
(let ((node (pop work-list)))
|
||||
(dolist (child (mh-container-children node))
|
||||
(push child work-list))
|
||||
(push node dfs-ordered-nodes)))
|
||||
(while dfs-ordered-nodes
|
||||
(let ((node (pop dfs-ordered-nodes)))
|
||||
(cond ((gethash (mh-message-id (mh-container-message node))
|
||||
mh-thread-id-index-map)
|
||||
;; Keep it
|
||||
(setf (mh-container-children node)
|
||||
(mh-thread-sort-containers (mh-container-children node))))
|
||||
((and (mh-container-children node)
|
||||
(or (null (cdr (mh-container-children node)))
|
||||
(mh-container-parent node)))
|
||||
;; Promote kids
|
||||
(let ((children ()))
|
||||
(dolist (kid (mh-container-children node))
|
||||
(mh-thread-remove-parent-link kid)
|
||||
(mh-thread-add-link (mh-container-parent node) kid)
|
||||
(push kid children))
|
||||
(push `(PROMOTE ,node ,(mh-container-parent node) ,@children)
|
||||
mh-thread-history)
|
||||
(mh-thread-remove-parent-link node)))
|
||||
((mh-container-children node)
|
||||
;; Promote the first orphan to parent and add the other kids as
|
||||
;; his children
|
||||
(setf (mh-container-children node)
|
||||
(mh-thread-sort-containers (mh-container-children node)))
|
||||
(let ((new-parent (car (mh-container-children node)))
|
||||
(other-kids (cdr (mh-container-children node))))
|
||||
(mh-thread-remove-parent-link new-parent)
|
||||
(dolist (kid other-kids)
|
||||
(mh-thread-remove-parent-link kid)
|
||||
(setf (mh-container-real-child-p kid) nil)
|
||||
(mh-thread-add-link new-parent kid t))
|
||||
(push `(PROMOTE ,node ,(mh-container-parent node)
|
||||
,new-parent ,@other-kids)
|
||||
mh-thread-history)
|
||||
(mh-thread-remove-parent-link node)))
|
||||
(t
|
||||
;; Drop it
|
||||
(push `(DROP ,node ,(mh-container-parent node))
|
||||
mh-thread-history)
|
||||
(mh-thread-remove-parent-link node)))))
|
||||
(let ((results ()))
|
||||
(maphash #'(lambda (k v)
|
||||
(declare (ignore k))
|
||||
(when (and (null (mh-container-parent v))
|
||||
(gethash (mh-message-id (mh-container-message v))
|
||||
mh-thread-id-index-map))
|
||||
(push v results)))
|
||||
mh-thread-id-table)
|
||||
(mh-thread-sort-containers results))))
|
||||
|
||||
(defun mh-thread-sort-containers (containers)
|
||||
"Sort a list of message CONTAINERS to be in ascending order wrt index."
|
||||
(sort containers
|
||||
#'(lambda (x y)
|
||||
(when (and (mh-container-message x) (mh-container-message y))
|
||||
(let* ((id-x (mh-message-id (mh-container-message x)))
|
||||
(id-y (mh-message-id (mh-container-message y)))
|
||||
(index-x (gethash id-x mh-thread-id-index-map))
|
||||
(index-y (gethash id-y mh-thread-id-index-map)))
|
||||
(and (integerp index-x) (integerp index-y)
|
||||
(< index-x index-y)))))))
|
||||
|
||||
(defvar mh-thread-last-ancestor)
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-print-scan-lines (thread-tree)
|
||||
"Print scan lines in THREAD-TREE in threaded mode."
|
||||
(let ((mh-thread-body-width (- (window-width) mh-cmd-note
|
||||
(1- mh-scan-field-subject-start-offset)))
|
||||
(mh-thread-last-ancestor nil))
|
||||
(if (null mh-index-data)
|
||||
(mh-thread-generate-scan-lines thread-tree -2)
|
||||
(loop for x in (mh-index-group-by-folder)
|
||||
do (let* ((old-map mh-thread-scan-line-map)
|
||||
(mh-thread-scan-line-map (make-hash-table)))
|
||||
(setq mh-thread-last-ancestor nil)
|
||||
(loop for msg in (cdr x)
|
||||
do (let ((v (gethash msg old-map)))
|
||||
(when v
|
||||
(setf (gethash msg mh-thread-scan-line-map) v))))
|
||||
(when (> (hash-table-count mh-thread-scan-line-map) 0)
|
||||
(insert (if (bobp) "" "\n") (car x) "\n")
|
||||
(mh-thread-generate-scan-lines thread-tree -2))))
|
||||
(mh-index-create-imenu-index))))
|
||||
|
||||
(defun mh-thread-generate-scan-lines (tree level)
|
||||
"Generate scan lines.
|
||||
TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps
|
||||
message indices to the corresponding scan lines and LEVEL used to
|
||||
determine indentation of the message."
|
||||
(cond ((null tree) nil)
|
||||
((mh-thread-container-p tree)
|
||||
(let* ((message (mh-container-message tree))
|
||||
(id (mh-message-id message))
|
||||
(index (gethash id mh-thread-id-index-map))
|
||||
(duplicates (gethash id mh-thread-duplicates))
|
||||
(new-level (+ level 2))
|
||||
(dupl-flag t)
|
||||
(force-angle-flag nil)
|
||||
(increment-level-flag nil))
|
||||
(dolist (scan-line (mapcar (lambda (x)
|
||||
(gethash x mh-thread-scan-line-map))
|
||||
(reverse (cons index duplicates))))
|
||||
(when scan-line
|
||||
(when (and dupl-flag (equal level 0)
|
||||
(mh-thread-ancestor-p mh-thread-last-ancestor tree))
|
||||
(setq level (+ level 2)
|
||||
new-level (+ new-level 2)
|
||||
force-angle-flag t))
|
||||
(when (equal level 0)
|
||||
(setq mh-thread-last-ancestor tree)
|
||||
(while (mh-container-parent mh-thread-last-ancestor)
|
||||
(setq mh-thread-last-ancestor
|
||||
(mh-container-parent mh-thread-last-ancestor))))
|
||||
(let* ((lev (if dupl-flag level new-level))
|
||||
(square-flag (or (and (mh-container-real-child-p tree)
|
||||
(not force-angle-flag)
|
||||
dupl-flag)
|
||||
(equal lev 0))))
|
||||
(insert (car scan-line)
|
||||
(format (format "%%%ss" lev) "")
|
||||
(if square-flag "[" "<")
|
||||
(cadr scan-line)
|
||||
(if square-flag "]" ">")
|
||||
(truncate-string-to-width
|
||||
(caddr scan-line) (- mh-thread-body-width lev))
|
||||
"\n"))
|
||||
(setq increment-level-flag t)
|
||||
(setq dupl-flag nil)))
|
||||
(unless increment-level-flag (setq new-level level))
|
||||
(dolist (child (mh-container-children tree))
|
||||
(mh-thread-generate-scan-lines child new-level))))
|
||||
(t (let ((nlevel (+ level 2)))
|
||||
(dolist (ch tree)
|
||||
(mh-thread-generate-scan-lines ch nlevel))))))
|
||||
|
||||
|
||||
|
||||
;;; Additional Utilities
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-update-scan-line-map (msg notation offset)
|
||||
"In threaded view update `mh-thread-scan-line-map'.
|
||||
MSG is the message being notated with NOTATION at OFFSET."
|
||||
(let* ((msg (or msg (mh-get-msg-num nil)))
|
||||
(cur-scan-line (and mh-thread-scan-line-map
|
||||
(gethash msg mh-thread-scan-line-map)))
|
||||
(old-scan-lines (loop for map in mh-thread-scan-line-map-stack
|
||||
collect (and map (gethash msg map)))))
|
||||
(when cur-scan-line
|
||||
(setf (aref (car cur-scan-line) offset) notation))
|
||||
(dolist (line old-scan-lines)
|
||||
(when line (setf (aref (car line) offset) notation)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-find-msg-subject (msg)
|
||||
"Find canonicalized subject of MSG.
|
||||
This function can only be used the folder is threaded."
|
||||
(ignore-errors
|
||||
(mh-message-subject
|
||||
(mh-container-message (gethash (gethash msg mh-thread-index-id-map)
|
||||
mh-thread-id-table)))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-add-spaces (count)
|
||||
"Add COUNT spaces to each scan line in `mh-thread-scan-line-map'."
|
||||
(let ((spaces (format (format "%%%ss" count) "")))
|
||||
(while (not (eobp))
|
||||
(let* ((msg-num (mh-get-msg-num nil))
|
||||
(old-line (nth 3 (gethash msg-num mh-thread-scan-line-map))))
|
||||
(when (numberp msg-num)
|
||||
(setf (gethash msg-num mh-thread-scan-line-map)
|
||||
(mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))
|
||||
(forward-line 1))))
|
||||
|
||||
;;;###mh-autoload
|
||||
(defun mh-thread-forget-message (index)
|
||||
"Forget the message INDEX from the threading tables."
|
||||
(let* ((id (gethash index mh-thread-index-id-map))
|
||||
(id-index (gethash id mh-thread-id-index-map))
|
||||
(duplicates (gethash id mh-thread-duplicates)))
|
||||
(remhash index mh-thread-index-id-map)
|
||||
(remhash index mh-thread-scan-line-map)
|
||||
(cond ((and (eql index id-index) (null duplicates))
|
||||
(remhash id mh-thread-id-index-map))
|
||||
((eql index id-index)
|
||||
(setf (gethash id mh-thread-id-index-map) (car duplicates))
|
||||
(setf (gethash (car duplicates) mh-thread-index-id-map) id)
|
||||
(setf (gethash id mh-thread-duplicates) (cdr duplicates)))
|
||||
(t
|
||||
(setf (gethash id mh-thread-duplicates)
|
||||
(remove index duplicates))))))
|
||||
|
||||
(provide 'mh-thread)
|
||||
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; sentence-end-double-space: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: b10e62f5-f028-4e04-873e-89d0e069b3d5
|
||||
;;; mh-thread.el ends here
|
||||
420
lisp/mh-e/mh-tool-bar.el
Normal file
420
lisp/mh-e/mh-tool-bar.el
Normal file
|
|
@ -0,0 +1,420 @@
|
|||
;;; mh-tool-bar.el --- MH-E tool bar support
|
||||
|
||||
;; Copyright (C) 2002, 2003, 2005, 2006 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
|
||||
;; Maintainer: Bill Wohler <wohler@newt.com>
|
||||
;; Keywords: mail
|
||||
;; See: mh-e.el
|
||||
|
||||
;; 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:
|
||||
|
||||
;;; Change Log:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'mh-e)
|
||||
|
||||
;;; Tool Bar Commands
|
||||
|
||||
(defun mh-tool-bar-search (&optional arg)
|
||||
"Interactively call `mh-tool-bar-search-function'.
|
||||
Optional argument ARG is not used."
|
||||
(interactive "P")
|
||||
(call-interactively mh-tool-bar-search-function))
|
||||
|
||||
(defun mh-tool-bar-customize ()
|
||||
"Call `mh-customize' from the tool bar."
|
||||
(interactive)
|
||||
(mh-customize t))
|
||||
|
||||
(defun mh-tool-bar-folder-help ()
|
||||
"Visit \"(mh-e)Top\"."
|
||||
(interactive)
|
||||
(info "(mh-e)Top")
|
||||
(delete-other-windows))
|
||||
|
||||
(defun mh-tool-bar-letter-help ()
|
||||
"Visit \"(mh-e)Editing Drafts\"."
|
||||
(interactive)
|
||||
(info "(mh-e)Editing Drafts")
|
||||
(delete-other-windows))
|
||||
|
||||
(defmacro mh-tool-bar-reply-generator (function recipient folder-buffer-flag)
|
||||
"Generate FUNCTION that replies to RECIPIENT.
|
||||
If FOLDER-BUFFER-FLAG is nil then the function generated...
|
||||
When INCLUDE-FLAG is non-nil, include message body being replied to."
|
||||
`(defun ,function (&optional arg)
|
||||
,(format "Reply to \"%s\".\nWhen ARG is non-nil include message in reply."
|
||||
recipient)
|
||||
(interactive "P")
|
||||
,(if folder-buffer-flag nil '(set-buffer mh-show-folder-buffer))
|
||||
(mh-reply (mh-get-msg-num nil) ,recipient arg)))
|
||||
|
||||
(mh-tool-bar-reply-generator mh-tool-bar-reply-from "from" t)
|
||||
(mh-tool-bar-reply-generator mh-show-tool-bar-reply-from "from" nil)
|
||||
(mh-tool-bar-reply-generator mh-tool-bar-reply-to "to" t)
|
||||
(mh-tool-bar-reply-generator mh-show-tool-bar-reply-to "to" nil)
|
||||
(mh-tool-bar-reply-generator mh-tool-bar-reply-all "all" t)
|
||||
(mh-tool-bar-reply-generator mh-show-tool-bar-reply-all "all" nil)
|
||||
|
||||
|
||||
|
||||
;;; Tool Bar Creation
|
||||
|
||||
(defmacro mh-tool-bar-define (defaults &rest buttons)
|
||||
"Define a tool bar for MH-E.
|
||||
DEFAULTS is the list of buttons that are present by default. It
|
||||
is a list of lists where the sublists are of the following form:
|
||||
|
||||
(:KEYWORD FUNC1 FUNC2 FUNC3 ...)
|
||||
|
||||
Here :KEYWORD is one of :folder or :letter. If it is :folder then
|
||||
the default buttons in the folder and show mode buffers are being
|
||||
specified. If it is :letter then the default buttons in the
|
||||
letter mode are listed. FUNC1, FUNC2, FUNC3, ... are the names of
|
||||
the functions that the buttons would execute.
|
||||
|
||||
Each element of BUTTONS is a list consisting of four mandatory
|
||||
items and one optional item as follows:
|
||||
|
||||
(FUNCTION MODES ICON DOC &optional ENABLE-EXPR)
|
||||
|
||||
where,
|
||||
|
||||
FUNCTION is the name of the function that will be executed when
|
||||
the button is clicked.
|
||||
|
||||
MODES is a list of symbols. List elements must be from \"folder\",
|
||||
\"letter\" and \"sequence\". If \"folder\" is present then the button is
|
||||
available in the folder and show buffer. If the name of FUNCTION is
|
||||
of the form \"mh-foo\", where foo is some arbitrary string, then we
|
||||
check if the function `mh-show-foo' exists. If it exists then that
|
||||
function is used in the show buffer. Otherwise the original function
|
||||
`mh-foo' is used in the show buffer as well. Presence of \"sequence\"
|
||||
is handled similar to the above. The only difference is that the
|
||||
button is shown only when the folder is narrowed to a sequence. If
|
||||
\"letter\" is present in MODES, then the button is available during
|
||||
draft editing and runs FUNCTION when clicked.
|
||||
|
||||
ICON is the icon that is drawn in the button.
|
||||
|
||||
DOC is the documentation for the button. It is used in tool-tips and
|
||||
in providing other help to the user. GNU Emacs uses only the first
|
||||
line of the string. So the DOC should be formatted such that the
|
||||
first line is useful and complete without the rest of the string.
|
||||
|
||||
Optional item ENABLE-EXPR is an arbitrary lisp expression. If it
|
||||
evaluates to nil, then the button is deactivated, otherwise it is
|
||||
active. If it isn't present then the button is always active."
|
||||
;; The following variable names have been carefully chosen to make code
|
||||
;; generation easier. Modifying the names should be done carefully.
|
||||
(let (folder-buttons folder-docs folder-button-setter sequence-button-setter
|
||||
show-buttons show-button-setter show-seq-button-setter
|
||||
letter-buttons letter-docs letter-button-setter
|
||||
folder-defaults letter-defaults
|
||||
folder-vectors show-vectors letter-vectors)
|
||||
(dolist (x defaults)
|
||||
(cond ((eq (car x) :folder) (setq folder-defaults (cdr x)))
|
||||
((eq (car x) :letter) (setq letter-defaults (cdr x)))))
|
||||
(dolist (button buttons)
|
||||
(unless (and (listp button)
|
||||
(or (equal (length button) 4) (equal (length button) 5)))
|
||||
(error "Incorrect MH-E tool-bar button specification: %s" button))
|
||||
(let* ((name (nth 0 button))
|
||||
(name-str (symbol-name name))
|
||||
(icon (nth 2 button))
|
||||
(xemacs-icon (mh-do-in-xemacs
|
||||
(cdr (assoc (intern icon) mh-xemacs-icon-map))))
|
||||
(full-doc (nth 3 button))
|
||||
(doc (if (string-match "\\(.*\\)\n" full-doc)
|
||||
(match-string 1 full-doc)
|
||||
full-doc))
|
||||
(enable-expr (or (nth 4 button) t))
|
||||
(modes (nth 1 button))
|
||||
functions show-sym)
|
||||
(when (memq 'letter modes) (setq functions `(:letter ,name)))
|
||||
(when (or (memq 'folder modes) (memq 'sequence modes))
|
||||
(setq functions
|
||||
(append `(,(if (memq 'folder modes) :folder :sequence) ,name)
|
||||
functions))
|
||||
(setq show-sym
|
||||
(if (string-match "^mh-\\(.*\\)$" name-str)
|
||||
(intern (concat "mh-show-" (match-string 1 name-str)))
|
||||
name))
|
||||
(setq functions
|
||||
(append `(,(if (memq 'folder modes) :show :show-seq)
|
||||
,(if (fboundp show-sym) show-sym name))
|
||||
functions)))
|
||||
(do ((functions functions (cddr functions)))
|
||||
((null functions))
|
||||
(let* ((type (car functions))
|
||||
(function (cadr functions))
|
||||
(type1 (substring (symbol-name type) 1))
|
||||
(vector-list (cond ((eq type :show) 'show-vectors)
|
||||
((eq type :show-seq) 'show-vectors)
|
||||
((eq type :letter) 'letter-vectors)
|
||||
(t 'folder-vectors)))
|
||||
(list (cond ((eq type :letter) 'mh-tool-bar-letter-buttons)
|
||||
(t 'mh-tool-bar-folder-buttons)))
|
||||
(key (intern (concat "mh-" type1 "tool-bar-" name-str)))
|
||||
(setter (intern (concat type1 "-button-setter")))
|
||||
(mbuttons (cond ((eq type :letter) 'letter-buttons)
|
||||
((eq type :show) 'show-buttons)
|
||||
((eq type :show-seq) 'show-buttons)
|
||||
(t 'folder-buttons)))
|
||||
(docs (cond ((eq mbuttons 'letter-buttons) 'letter-docs)
|
||||
((eq mbuttons 'folder-buttons) 'folder-docs))))
|
||||
(add-to-list vector-list `[,xemacs-icon ,function t ,full-doc])
|
||||
(add-to-list
|
||||
setter `(when (member ',name ,list)
|
||||
(mh-funcall-if-exists
|
||||
tool-bar-add-item ,icon ',function ',key
|
||||
:help ,doc :enable ',enable-expr)))
|
||||
(add-to-list mbuttons name)
|
||||
(if docs (add-to-list docs doc))))))
|
||||
(setq folder-buttons (nreverse folder-buttons)
|
||||
letter-buttons (nreverse letter-buttons)
|
||||
show-buttons (nreverse show-buttons)
|
||||
letter-docs (nreverse letter-docs)
|
||||
folder-docs (nreverse folder-docs)
|
||||
folder-vectors (nreverse folder-vectors)
|
||||
show-vectors (nreverse show-vectors)
|
||||
letter-vectors (nreverse letter-vectors))
|
||||
(dolist (x folder-defaults)
|
||||
(unless (memq x folder-buttons)
|
||||
(error "Folder defaults contains unknown button '%s'" x)))
|
||||
(dolist (x letter-defaults)
|
||||
(unless (memq x letter-buttons)
|
||||
(error "Letter defaults contains unknown button '%s'" x)))
|
||||
`(eval-when (compile load eval)
|
||||
(defun mh-buffer-exists-p (mode)
|
||||
"Test whether a buffer with major mode MODE is present."
|
||||
(loop for buf in (buffer-list)
|
||||
when (save-excursion
|
||||
(set-buffer buf)
|
||||
(eq major-mode mode))
|
||||
return t))
|
||||
|
||||
;; GNU Emacs tool bar specific code
|
||||
(mh-do-in-gnu-emacs
|
||||
;; Tool bar initialization functions
|
||||
(defun mh-tool-bar-folder-buttons-init ()
|
||||
(when (mh-buffer-exists-p 'mh-folder-mode)
|
||||
(mh-image-load-path)
|
||||
(setq mh-folder-tool-bar-map
|
||||
(let ((tool-bar-map (make-sparse-keymap)))
|
||||
,@(nreverse folder-button-setter)
|
||||
tool-bar-map))
|
||||
(setq mh-show-tool-bar-map
|
||||
(let ((tool-bar-map (make-sparse-keymap)))
|
||||
,@(nreverse show-button-setter)
|
||||
tool-bar-map))
|
||||
(setq mh-show-seq-tool-bar-map
|
||||
(let ((tool-bar-map (copy-keymap mh-show-tool-bar-map)))
|
||||
,@(nreverse show-seq-button-setter)
|
||||
tool-bar-map))
|
||||
(setq mh-folder-seq-tool-bar-map
|
||||
(let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map)))
|
||||
,@(nreverse sequence-button-setter)
|
||||
tool-bar-map))))
|
||||
(defun mh-tool-bar-letter-buttons-init ()
|
||||
(when (mh-buffer-exists-p 'mh-letter-mode)
|
||||
(mh-image-load-path)
|
||||
(setq mh-letter-tool-bar-map
|
||||
(let ((tool-bar-map (make-sparse-keymap)))
|
||||
,@(nreverse letter-button-setter)
|
||||
tool-bar-map))))
|
||||
;; Custom setter functions
|
||||
(defun mh-tool-bar-folder-buttons-set (symbol value)
|
||||
"Construct tool bar for `mh-folder-mode' and `mh-show-mode'."
|
||||
(set-default symbol value)
|
||||
(mh-tool-bar-folder-buttons-init))
|
||||
(defun mh-tool-bar-letter-buttons-set (symbol value)
|
||||
"Construct tool bar for `mh-letter-mode'."
|
||||
(set-default symbol value)
|
||||
(mh-tool-bar-letter-buttons-init)))
|
||||
;; XEmacs specific code
|
||||
(mh-do-in-xemacs
|
||||
(defvar mh-tool-bar-folder-vector-map
|
||||
',(loop for button in folder-buttons
|
||||
for vector in folder-vectors
|
||||
collect (cons button vector)))
|
||||
(defvar mh-tool-bar-show-vector-map
|
||||
',(loop for button in show-buttons
|
||||
for vector in show-vectors
|
||||
collect (cons button vector)))
|
||||
(defvar mh-tool-bar-letter-vector-map
|
||||
',(loop for button in letter-buttons
|
||||
for vector in letter-vectors
|
||||
collect (cons button vector)))
|
||||
(defvar mh-tool-bar-folder-buttons nil)
|
||||
(defvar mh-tool-bar-show-buttons nil)
|
||||
(defvar mh-tool-bar-letter-buttons nil)
|
||||
;; Custom setter functions
|
||||
(defun mh-tool-bar-letter-buttons-set (symbol value)
|
||||
(set-default symbol value)
|
||||
(when mh-xemacs-has-tool-bar-flag
|
||||
(setq mh-tool-bar-letter-buttons
|
||||
(loop for b in value
|
||||
collect (cdr (assoc b mh-tool-bar-letter-vector-map))))))
|
||||
(defun mh-tool-bar-folder-buttons-set (symbol value)
|
||||
(set-default symbol value)
|
||||
(when mh-xemacs-has-tool-bar-flag
|
||||
(setq mh-tool-bar-folder-buttons
|
||||
(loop for b in value
|
||||
collect (cdr (assoc b mh-tool-bar-folder-vector-map))))
|
||||
(setq mh-tool-bar-show-buttons
|
||||
(loop for b in value
|
||||
collect (cdr (assoc b mh-tool-bar-show-vector-map))))))
|
||||
(defun mh-tool-bar-init (mode)
|
||||
"Install tool bar in MODE."
|
||||
(let ((tool-bar (cond ((eq mode :folder) mh-tool-bar-folder-buttons)
|
||||
((eq mode :letter) mh-tool-bar-letter-buttons)
|
||||
((eq mode :show) mh-tool-bar-show-buttons)))
|
||||
(height 37)
|
||||
(width 40)
|
||||
(buffer (current-buffer)))
|
||||
(when mh-xemacs-use-tool-bar-flag
|
||||
(cond
|
||||
((eq mh-xemacs-tool-bar-position 'top)
|
||||
(set-specifier top-toolbar tool-bar buffer)
|
||||
(set-specifier top-toolbar-visible-p t)
|
||||
(set-specifier top-toolbar-height height))
|
||||
((eq mh-xemacs-tool-bar-position 'bottom)
|
||||
(set-specifier bottom-toolbar tool-bar buffer)
|
||||
(set-specifier bottom-toolbar-visible-p t)
|
||||
(set-specifier bottom-toolbar-height height))
|
||||
((eq mh-xemacs-tool-bar-position 'left)
|
||||
(set-specifier left-toolbar tool-bar buffer)
|
||||
(set-specifier left-toolbar-visible-p t)
|
||||
(set-specifier left-toolbar-width width))
|
||||
((eq mh-xemacs-tool-bar-position 'right)
|
||||
(set-specifier right-toolbar tool-bar buffer)
|
||||
(set-specifier right-toolbar-visible-p t)
|
||||
(set-specifier right-toolbar-width width))
|
||||
(t (set-specifier default-toolbar tool-bar buffer)))))))
|
||||
;; Declare customizable tool bars
|
||||
(custom-declare-variable
|
||||
'mh-tool-bar-folder-buttons
|
||||
'(list ,@(mapcar (lambda (x) `(quote ,x)) folder-defaults))
|
||||
"List of buttons to include in MH-Folder tool bar."
|
||||
:group 'mh-tool-bar :set 'mh-tool-bar-folder-buttons-set
|
||||
:type '(set ,@(loop for x in folder-buttons
|
||||
for y in folder-docs
|
||||
collect `(const :tag ,y ,x))))
|
||||
(custom-declare-variable
|
||||
'mh-tool-bar-letter-buttons
|
||||
'(list ,@(mapcar (lambda (x) `(quote ,x)) letter-defaults))
|
||||
"List of buttons to include in MH-Letter tool bar."
|
||||
:group 'mh-tool-bar :set 'mh-tool-bar-letter-buttons-set
|
||||
:type '(set ,@(loop for x in letter-buttons
|
||||
for y in letter-docs
|
||||
collect `(const :tag ,y ,x)))))))
|
||||
|
||||
(mh-tool-bar-define
|
||||
((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg
|
||||
mh-page-msg mh-next-undeleted-msg mh-delete-msg mh-refile-msg
|
||||
mh-undo mh-execute-commands mh-toggle-tick mh-reply
|
||||
mh-alias-grab-from-field mh-send mh-rescan-folder
|
||||
mh-tool-bar-search mh-visit-folder
|
||||
mh-tool-bar-customize mh-tool-bar-folder-help mh-widen)
|
||||
(:letter mh-send-letter mh-compose-insertion ispell-message save-buffer
|
||||
undo kill-region menu-bar-kill-ring-save yank mh-fully-kill-draft
|
||||
mh-tool-bar-customize mh-tool-bar-letter-help))
|
||||
;; Folder/Show buffer buttons
|
||||
(mh-inc-folder (folder) "mail"
|
||||
"Incorporate new mail in Inbox
|
||||
This button runs `mh-inc-folder' which drags any
|
||||
new mail into your Inbox folder.")
|
||||
(mh-mime-save-parts (folder) "attach"
|
||||
"Save MIME parts from this message
|
||||
This button runs `mh-mime-save-parts' which saves a message's
|
||||
different parts into separate files.")
|
||||
(mh-previous-undeleted-msg (folder) "left-arrow"
|
||||
"Go to the previous undeleted message
|
||||
This button runs `mh-previous-undeleted-msg'")
|
||||
(mh-page-msg (folder) "page-down"
|
||||
"Page the current message forwards\nThis button runs `mh-page-msg'")
|
||||
(mh-next-undeleted-msg (folder) "right-arrow"
|
||||
"Go to the next undeleted message\nThe button runs `mh-next-undeleted-msg'")
|
||||
(mh-delete-msg (folder) "close"
|
||||
"Mark this message for deletion\nThis button runs `mh-delete-msg'")
|
||||
(mh-refile-msg (folder) "mail/refile"
|
||||
"Refile this message\nThis button runs `mh-refile-msg'")
|
||||
(mh-undo (folder) "undo" "Undo last operation\nThis button runs `undo'"
|
||||
(mh-outstanding-commands-p))
|
||||
(mh-execute-commands (folder) "execute"
|
||||
"Perform moves and deletes\nThis button runs `mh-execute-commands'"
|
||||
(mh-outstanding-commands-p))
|
||||
(mh-toggle-tick (folder) "highlight"
|
||||
"Toggle tick mark\nThis button runs `mh-toggle-tick'")
|
||||
(mh-toggle-showing (folder) "show"
|
||||
"Toggle showing message\nThis button runs `mh-toggle-showing'")
|
||||
(mh-tool-bar-reply-from (folder) "mail/reply-from" "Reply to \"from\"")
|
||||
(mh-tool-bar-reply-to (folder) "mail/reply-to" "Reply to \"to\"")
|
||||
(mh-tool-bar-reply-all (folder) "mail/reply-all" "Reply to \"all\"")
|
||||
(mh-reply (folder) "mail/reply"
|
||||
"Reply to this message\nThis button runs `mh-reply'")
|
||||
(mh-alias-grab-from-field (folder) "mail/alias"
|
||||
"Grab From alias\nThis button runs `mh-alias-grab-from-field'"
|
||||
(and (mh-extract-from-header-value) (not (mh-alias-for-from-p))))
|
||||
(mh-send (folder) "mail/compose"
|
||||
"Compose new message\nThis button runs `mh-send'")
|
||||
(mh-rescan-folder (folder) "refresh"
|
||||
"Rescan this folder\nThis button runs `mh-rescan-folder'")
|
||||
(mh-pack-folder (folder) "mail/repack"
|
||||
"Repack this folder\nThis button runs `mh-pack-folder'")
|
||||
(mh-tool-bar-search (folder) "search"
|
||||
"Search\nThis button runs `mh-tool-bar-search-function'")
|
||||
(mh-visit-folder (folder) "fld-open"
|
||||
"Visit other folder\nThis button runs `mh-visit-folder'")
|
||||
;; Letter buffer buttons
|
||||
(mh-send-letter (letter) "mail/send" "Send this letter")
|
||||
(mh-compose-insertion (letter) "attach" "Insert attachment")
|
||||
(ispell-message (letter) "spell" "Check spelling")
|
||||
(save-buffer (letter) "save" "Save current buffer to its file"
|
||||
(buffer-modified-p))
|
||||
(undo (letter) "undo" "Undo last operation")
|
||||
(kill-region (letter) "cut"
|
||||
"Cut (kill) text in region between mark and current position")
|
||||
(menu-bar-kill-ring-save (letter) "copy"
|
||||
"Copy text in region between mark and current position")
|
||||
(yank (letter) "paste" "Paste (yank) text cut or copied earlier")
|
||||
(mh-fully-kill-draft (letter) "close" "Kill this draft")
|
||||
;; Common buttons
|
||||
(mh-tool-bar-customize (folder letter) "preferences" "MH-E Preferences")
|
||||
(mh-tool-bar-folder-help (folder) "help"
|
||||
"Help! (general help)\nThis button runs `info'")
|
||||
(mh-tool-bar-letter-help (letter) "help"
|
||||
"Help! (general help)\nThis button runs `info'")
|
||||
;; Folder narrowed to sequence buttons
|
||||
(mh-widen (sequence) "widen"
|
||||
"Widen from the sequence\nThis button runs `mh-widen'"))
|
||||
|
||||
(provide 'mh-tool-bar)
|
||||
|
||||
;; Local Variables:
|
||||
;; indent-tabs-mode: nil
|
||||
;; sentence-end-double-space: nil
|
||||
;; End:
|
||||
|
||||
;; arch-tag: 28c2436d-bb8d-486a-a8d7-5a4d9cae3513
|
||||
;;; mh-tool-bar.el ends here
|
||||
File diff suppressed because it is too large
Load diff
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Reference in a new issue