Mercurial > emacs
changeset 84387:4ee03308c9b6
Sync ERC 5.3 (devel) from upstream
| author | Michael Olson <mwolson@gnu.org> |
|---|---|
| date | Sat, 08 Sep 2007 03:07:09 +0000 |
| parents | 869c721b5469 |
| children | 218339cfde04 |
| files | doc/misc/ChangeLog doc/misc/erc.texi etc/ChangeLog etc/ERC-NEWS lisp/erc/erc-backend.el lisp/erc/erc-button.el lisp/erc/erc-compat.el lisp/erc/erc-goodies.el lisp/erc/erc-identd.el lisp/erc/erc-log.el lisp/erc/erc-sound.el lisp/erc/erc-stamp.el lisp/erc/erc-track.el lisp/erc/erc.el |
| diffstat | 14 files changed, 512 insertions(+), 190 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/misc/ChangeLog Sat Sep 08 01:38:27 2007 +0000 +++ b/doc/misc/ChangeLog Sat Sep 08 03:07:09 2007 +0000 @@ -1,3 +1,8 @@ +2007-09-08 Michael Olson <mwolson@gnu.org> + + * erc.texi (Copying): New section included from gpl.texi. This matches + the look of the upstream ERC manual. + 2007-09-07 Jay Belanger <jay.p.belanger@gmail.com> * calc.texi (History and Acknowledgements): Adjust the
--- a/doc/misc/erc.texi Sat Sep 08 01:38:27 2007 +0000 +++ b/doc/misc/erc.texi Sat Sep 08 03:07:09 2007 +0000 @@ -68,6 +68,10 @@ * Advanced Usage:: Cool ways of using ERC. * Getting Help and Reporting Bugs:: * History:: The history of ERC. +* Copying:: The GNU General Public License gives you + permission to redistribute ERC on + certain terms; it also explains that + there is no warranty. * GNU Free Documentation License:: The license for this documentation. * Concept Index:: Search for terms. @@ -900,7 +904,7 @@ @c previous chapter) This section has not yet been written. For now, the easiest way to -check out the available option for ERC is to do +check out the available options for ERC is to do @kbd{M-x customize-group erc RET}. @@ -916,7 +920,7 @@ @itemize @bullet @item -@uref{http://www.emacswiki.org/cgi-bin/wiki/EmacsIRCClient} is the +@uref{http://www.emacswiki.org/cgi-bin/wiki/ERC} is the emacswiki.org page for ERC. Anyone may add tips, hints, or bug descriptions to it. @@ -929,14 +933,11 @@ accessing the mailing lists, adding content to them, and searching them. @enumerate -@item gmane.emacs.erc.announce -Announcements +@item gmane.emacs.erc.announce: Announcements -@item gmane.emacs.erc.discuss -General discussion +@item gmane.emacs.erc.discuss: General discussion -@item gmane.emacs.erc.cvs -Log messages for changes to the ERC source code +@item gmane.emacs.erc.cvs: Log messages for changes to the ERC source code @end enumerate @@ -948,7 +949,7 @@ @end itemize -@node History, GNU Free Documentation License, Getting Help and Reporting Bugs, Top +@node History, Copying, Getting Help and Reporting Bugs, Top @comment node-name, next, previous, up @chapter History @cindex history, of ERC @@ -1010,8 +1011,12 @@ @end itemize -@node GNU Free Documentation License, Concept Index, History, Top -@appendix GNU Free Documentation License +@node Copying, GNU Free Documentation License, History, Top +@comment node-name, next, previous, up +@include gpl.texi + +@node GNU Free Documentation License, Concept Index, Copying, Top +@comment node-name, next, previous, up @include doclicense.texi @node Concept Index, , GNU Free Documentation License, Top
--- a/etc/ChangeLog Sat Sep 08 01:38:27 2007 +0000 +++ b/etc/ChangeLog Sat Sep 08 03:07:09 2007 +0000 @@ -1,3 +1,8 @@ +2007-09-08 Michael Olson <mwolson@gnu.org> + + * ERC-NEWS: Update for changes to the development version of ERC + 5.3. + 2007-09-06 Glenn Morris <rgm@gnu.org> * ctags.1, emacs.1, emacsclient.1, etags.1: Move from etc/ to
--- a/etc/ERC-NEWS Sat Sep 08 01:38:27 2007 +0000 +++ b/etc/ERC-NEWS Sat Sep 08 03:07:09 2007 +0000 @@ -3,6 +3,22 @@ Copyright (C) 2006, 2007 Free Software Foundation, Inc. See the end of the file for license conditions. +* Changes in ERC 5.3 + +** New function `erc-tls' is to be used for connecting to a server via TLS. +The function `erc-ssl' should never be used for that purpose any +longer, which was the case with the version of ERC that is included +with Emacs. + +** Changes and additions to modules + +*** Channel tracking (erc-track.el) + +If erc-track-position-in-mode-line is set to nil, the tracking +information won't be shown in the mode line, which is a change +from the previous behavior of showing it "After all other +information". + * Changes in ERC 5.2 ** M-x erc RET now starts ERC.
--- a/lisp/erc/erc-backend.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc-backend.el Sat Sep 08 03:07:09 2007 +0000 @@ -550,11 +550,12 @@ (defun erc-server-reconnect () "Reestablish the current IRC connection. Make sure you are in an ERC buffer when running this." - (let ((server (erc-server-buffer))) - (unless (and server - (buffer-live-p server)) - (error "Couldn't switch to server buffer")) - (with-current-buffer server + (let ((buffer (erc-server-buffer))) + (unless (buffer-live-p buffer) + (if (eq major-mode 'erc-mode) + (setq buffer (current-buffer)) + (error "Reconnect must be run from an ERC buffer"))) + (with-current-buffer buffer (erc-update-mode-line) (erc-set-active-buffer (current-buffer)) (setq erc-server-last-sent-time 0) @@ -609,39 +610,61 @@ ;; open-network-stream-nowait error for connection refused (not (string-match "^failed with code 111" event))))) -(defun erc-process-sentinel-1 (event) +(defun erc-process-sentinel-2 (event buffer) + "Called when `erc-process-sentinel-1' has detected an unexpected disconnect." + (if (not (buffer-live-p buffer)) + (erc-update-mode-line) + (with-current-buffer buffer + (let ((reconnect-p (erc-server-reconnect-p event))) + (erc-display-message nil 'error (current-buffer) + (if reconnect-p 'disconnected + 'disconnected-noreconnect)) + (if (not reconnect-p) + ;; terminate, do not reconnect + (progn + (erc-display-message nil 'error (current-buffer) + 'terminated ?e event) + ;; Update mode line indicators + (erc-update-mode-line) + (set-buffer-modified-p nil)) + ;; reconnect + (condition-case err + (progn + (setq erc-server-reconnecting nil) + (erc-server-reconnect) + (setq erc-server-reconnect-count 0)) + (error (when (buffer-live-p buffer) + (set-buffer buffer) + (if (integerp erc-server-reconnect-attempts) + (setq erc-server-reconnect-count + (1+ erc-server-reconnect-count)) + (message "%s ... %s" + "Reconnecting until we succeed" + "kill the ERC server buffer to stop")) + (if (numberp erc-server-reconnect-timeout) + (run-at-time erc-server-reconnect-timeout nil + #'erc-process-sentinel-2 + event buffer) + (error (concat "`erc-server-reconnect-timeout`" + " must be a number"))))))))))) + +(defun erc-process-sentinel-1 (event buffer) "Called when `erc-process-sentinel' has decided that we're disconnecting. Determine whether user has quit or whether erc has been terminated. Conditionally try to reconnect and take appropriate action." - (if erc-server-quitting - ;; normal quit - (progn - (erc-display-message nil 'error (current-buffer) 'finished) - (when erc-kill-server-buffer-on-quit + (with-current-buffer buffer + (if erc-server-quitting + ;; normal quit + (progn + (erc-display-message nil 'error (current-buffer) 'finished) + ;; Update mode line indicators + (erc-update-mode-line) + ;; Kill server buffer if user wants it (set-buffer-modified-p nil) - (kill-buffer (current-buffer)))) - ;; unexpected disconnect - (let ((again t)) - (while again - (setq again nil) - (erc-display-message nil 'error (current-buffer) - (if (erc-server-reconnect-p event) - 'disconnected - 'disconnected-noreconnect)) - (if (erc-server-reconnect-p event) - (condition-case err - (progn - (setq erc-server-reconnecting nil) - (erc-server-reconnect) - (setq erc-server-reconnect-count 0)) - (error (when (integerp erc-server-reconnect-attempts) - (setq erc-server-reconnect-count - (1+ erc-server-reconnect-count)) - (sit-for erc-server-reconnect-timeout) - (setq again t)))) - ;; terminate, do not reconnect - (erc-display-message nil 'error (current-buffer) - 'terminated ?e event)))))) + (when erc-kill-server-buffer-on-quit + (kill-buffer (current-buffer)))) + ;; unexpected disconnect + (erc-process-sentinel-2 event buffer)))) (defun erc-process-sentinel (cproc event) "Sentinel function for ERC process." @@ -668,12 +691,7 @@ (delete-region (point) (point-max)) ;; Decide what to do with the buffer ;; Restart if disconnected - (erc-process-sentinel-1 event) - ;; Make sure we don't write to the buffer if it has been - ;; killed - (when (buffer-live-p buf) - (erc-update-mode-line) - (set-buffer-modified-p nil)))))) + (erc-process-sentinel-1 event buf))))) ;;;; Sending messages @@ -1054,8 +1072,11 @@ \"Some non-generic variable documentation. Hook called upon receiving a WHOIS server response. + Each function is called with two arguments, the process associated - with the response and the parsed response. + with the response and the parsed response. If the function returns + non-nil, stop processing the hook. Otherwise, continue. + See also `erc-server-311'.\") (defalias 'erc-server-WI 'erc-server-311) @@ -1064,7 +1085,9 @@ Hook called upon receiving a WI server response. Each function is called with two arguments, the process associated - with the response and the parsed response. + with the response and the parsed response. If the function returns + non-nil, stop processing the hook. Otherwise, continue. + See also `erc-server-311'.\")) \(fn (NAME &rest ALIASES) &optional EXTRA-FN-DOC EXTRA-VAR-DOC &rest FN-BODY)" @@ -1078,7 +1101,9 @@ (fn-name (intern (format "erc-server-%s" name))) (hook-doc (format "%sHook called upon receiving a %%s server response. Each function is called with two arguments, the process associated -with the response and the parsed response. +with the response and the parsed response. If the function returns +non-nil, stop processing the hook. Otherwise, continue. + See also `%s'." (if extra-var-doc (concat extra-var-doc "\n\n")
--- a/lisp/erc/erc-button.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc-button.el Sat Sep 08 03:07:09 2007 +0000 @@ -99,7 +99,7 @@ (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_=#$@~`%&*+\\/]") + "[-a-zA-Z0-9_=!?#$@~`%&*+\\/:;.,()]+[-a-zA-Z0-9_=#$@~`%&*+\\/()]") "Regular expression that matches URLs." :group 'erc-button :type 'regexp)
--- a/lisp/erc/erc-compat.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc-compat.el Sat Sep 08 03:07:09 2007 +0000 @@ -56,6 +56,18 @@ (format-time-string "%Y-%m-%d" emacs-build-time)) "Time at which Emacs was dumped out.") +;; Emacs 21 and XEmacs do not have user-emacs-directory, but XEmacs +;; has user-init-directory. +(defvar erc-user-emacs-directory + (cond ((boundp 'user-emacs-directory) + user-emacs-directory) + ((boundp 'user-init-directory) + user-init-directory) + (t "~/.emacs.d/")) + "Directory beneath which additional per-user Emacs-specific files +are placed. +Note that this should end with a directory separator.") + ;; 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) @@ -68,6 +80,7 @@ (replace-match newtext fixedcase literal string)) (t (replace-match newtext fixedcase literal string subexp)))) +(defalias 'erc-with-selected-window 'with-selected-window) (defalias 'erc-cancel-timer 'cancel-timer) (defalias 'erc-make-obsolete 'make-obsolete) (defalias 'erc-make-obsolete-variable 'make-obsolete-variable)
--- a/lisp/erc/erc-goodies.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc-goodies.el Sat Sep 08 03:07:09 2007 +0000 @@ -84,8 +84,7 @@ ;; 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) + (erc-with-selected-window window (save-restriction (widen) (when (and erc-insert-marker @@ -282,10 +281,8 @@ "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) + (prog1 'default + (erc-error "erc-get-bg-color-face: n is NaN: %S" n)) (when (> n 16) (erc-log (format " Wrong color: %s" n)) (setq n (mod n 16))) @@ -298,10 +295,8 @@ "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) + (prog1 'default + (erc-error "erc-get-fg-color-face: n is NaN: %S" n)) (when (> n 16) (erc-log (format " Wrong color: %s" n)) (setq n (mod n 16)))
--- a/lisp/erc/erc-identd.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc-identd.el Sat Sep 08 03:07:09 2007 +0000 @@ -74,7 +74,8 @@ (format "%s, %s : USERID : %s : %s\n" port-on-server port-on-client system-type (user-login-name))) - (process-send-eof erc-identd-process))))) + (stop-process erc-identd-process) + (delete-process proc))))) ;;;###autoload (defun erc-identd-start (&optional port)
--- a/lisp/erc/erc-log.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc-log.el Sat Sep 08 03:07:09 2007 +0000 @@ -31,17 +31,26 @@ ;; Quick start: ;; -;; (setq erc-enable-logging t) +;; (require 'erc-log) ;; (setq erc-log-channels-directory "/path/to/logfiles") ; must be writable +;; (erc-log-enable) +;; +;; Or: +;; +;; M-x customize-variable erc-modules, and add "log". ;; -;; 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". +;; There are two ways to setup logging. The first (default) method +;; will save buffers on /part, /quit, or killing the channel +;; buffer. ;; -;; The second method will save buffers on /part, /quit, or killing the -;; channel buffer. To do this, add the following to your .emacs: +;; The second will write to the log files on each incoming or outgoing +;; line - this may not be optimal on a laptop HDD. To use this +;; method, add the following to the above instructions. ;; -;; (require 'erc-log) +;; (setq erc-save-buffer-on-part nil +;; erc-save-queries-on-quit nil +;; erc-log-write-after-send t +;; erc-log-write-after-insert t) ;; ;; If you only want to save logs for some buffers, customise the ;; variable `erc-enable-logging'. @@ -99,15 +108,19 @@ 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'." +SERVER and PORT are the parameters that were used to connect to BUFFERs +`erc-server-process'. + +If you want to write logs into different directories, make a +custom function which returns the directory part and set +`erc-log-channels-directory' to its name." :group 'erc-log :type '(choice (const :tag "Long style" erc-generate-log-file-name-long) (const :tag "Long, but with network name rather than server" erc-generate-log-file-name-network) (const :tag "Short" erc-generate-log-file-name-short) (const :tag "With date" erc-generate-log-file-name-with-date) - (symbol :tag "Other function"))) + (function :tag "Other function"))) (defcustom erc-truncate-buffer-on-save nil "Truncate any ERC (channel, query, server) buffer when it is saved." @@ -134,10 +147,16 @@ "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." +directory should not end with a trailing slash. + +If this is the name of a function, the function will be called +with the buffer, target, nick, server, and port arguments. See +`erc-generate-log-file-name-function' for a description of these +arguments." :group 'erc-log :type '(choice directory - (const nil))) + (function "Function") + (const :tag "Disable logging" nil))) (defcustom erc-log-insert-log-on-open nil "*Insert log file contents into the buffer if a log file exists." @@ -297,7 +316,8 @@ 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) + (or (functionp 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))) @@ -316,14 +336,19 @@ 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 - (erc-log-standardize-name - (funcall erc-generate-log-file-name-function - (or buffer (current-buffer)) - (or (buffer-name buffer) (erc-default-target)) - (erc-current-nick) - erc-session-server erc-session-port)) - erc-log-channels-directory)) + (unless buffer (setq buffer (current-buffer))) + (let ((target (or (buffer-name buffer) (erc-default-target))) + (nick (erc-current-nick)) + (server erc-session-server) + (port erc-session-port)) + (expand-file-name + (erc-log-standardize-name + (funcall erc-generate-log-file-name-function + buffer target nick server port)) + (if (functionp erc-log-channels-directory) + (funcall erc-log-channels-directory + buffer target nick server port) + erc-log-channels-directory)))) (defun erc-generate-log-file-name-with-date (buffer &rest ignore) "This function computes a short log file name.
--- a/lisp/erc/erc-sound.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc-sound.el Sat Sep 08 03:07:09 2007 +0000 @@ -125,7 +125,7 @@ (if (and (not filepath) erc-default-sound) (setq filepath erc-default-sound)) (cond ((and filepath (file-exists-p filepath)) - (play-sound-file filepath)) + (play-sound-file filepath)) (t (beep))) (erc-log (format "Playing sound file %S" filepath)))) @@ -142,5 +142,11 @@ (provide 'erc-sound) +;;; erc-sound.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + ;; arch-tag: 53657d1d-007f-4a20-91c1-588e71cf0cee -;;; erc-sound.el ends here
--- a/lisp/erc/erc-stamp.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc-stamp.el Sat Sep 08 03:07:09 2007 +0000 @@ -58,16 +58,48 @@ :type '(choice (const nil) (string))) -(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-right +(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n" + "*If set to a string, messages will be timestamped. +This string is processed using `format-time-string'. +Good examples are \"%T\" and \"%H:%M\". + +This timestamp is used for timestamps on the left side of the +screen when `erc-insert-timestamp-function' is set to +`erc-insert-timestamp-left-and-right'. + +If nil, timestamping is turned off." + :group 'erc-stamp + :type '(choice (const nil) + (string))) + +(defcustom erc-timestamp-format-right " [%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\". + +This timestamp is used for timestamps on the right side of the +screen when `erc-insert-timestamp-function' is set to +`erc-insert-timestamp-left-and-right'. + +If nil, timestamping is turned off." + :group 'erc-stamp + :type '(choice (const nil) + (string))) + +(defcustom erc-insert-timestamp-function 'erc-insert-timestamp-left-and-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." +operate on. + +You will probably want to set +`erc-insert-away-timestamp-function' to the same value." :group 'erc-stamp - :type '(choice (const :tag "Right" erc-insert-timestamp-right) + :type '(choice (const :tag "Both sides" erc-insert-timestamp-left-and-right) + (const :tag "Right" erc-insert-timestamp-right) (const :tag "Left" erc-insert-timestamp-left) function)) @@ -82,12 +114,14 @@ :type '(choice (const nil) (string))) -(defcustom erc-insert-away-timestamp-function 'erc-insert-timestamp-right +(defcustom erc-insert-away-timestamp-function + 'erc-insert-timestamp-left-and-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) + :type '(choice (const :tag "Both sides" erc-insert-timestamp-left-and-right) + (const :tag "Right" erc-insert-timestamp-right) (const :tag "Left" erc-insert-timestamp-left) function)) @@ -160,6 +194,18 @@ "Last timestamp inserted into the buffer.") (make-variable-buffer-local 'erc-timestamp-last-inserted) +(defvar erc-timestamp-last-inserted-left nil + "Last timestamp inserted into the left side of the buffer. +This is used when `erc-insert-timestamp-function' is set to +`erc-timestamp-left-and-right'") +(make-variable-buffer-local 'erc-timestamp-last-inserted-left) + +(defvar erc-timestamp-last-inserted-right nil + "Last timestamp inserted into the right side of the buffer. +This is used when `erc-insert-timestamp-function' is set to +`erc-timestamp-left-and-right'") +(make-variable-buffer-local 'erc-timestamp-last-inserted-right) + (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 @@ -272,6 +318,26 @@ (when erc-timestamp-intangible (erc-put-text-property from (1+ (point)) 'intangible t))))) +(defun erc-insert-timestamp-left-and-right (string) + "This is another function that can be assigned to +`erc-insert-timestamp-function'. If the date is changed, it will +print a blank line, the date, and another blank line. If the time is +changed, it will then print it off to the right." + (let* ((ct (current-time)) + (ts-left (erc-format-timestamp ct erc-timestamp-format-left)) + (ts-right (erc-format-timestamp ct erc-timestamp-format-right))) + ;; insert left timestamp + (unless (string-equal ts-left erc-timestamp-last-inserted-left) + (goto-char (point-min)) + (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left) + (insert ts-left) + (setq erc-timestamp-last-inserted-left ts-left)) + ;; insert right timestamp + (let ((erc-timestamp-only-if-changed-flag t) + (erc-timestamp-last-inserted erc-timestamp-last-inserted-right)) + (erc-insert-timestamp-right ts-right) + (setq erc-timestamp-last-inserted-right ts-right)))) + ;; for testing: (setq erc-timestamp-only-if-changed-flag nil) (defun erc-format-timestamp (time format)
--- a/lisp/erc/erc-track.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc-track.el Sat Sep 08 03:07:09 2007 +0000 @@ -95,6 +95,12 @@ :group 'erc-track :type '(repeat string)) +(defcustom erc-track-remove-disconnected-buffers nil + "*If true, remove buffers associated with a server that is +disconnected from `erc-modified-channels-alist'." + :group 'erc-track + :type 'boolean) + (defcustom erc-track-exclude-types '("NICK") "*List of message types to be ignored. This list could look like '(\"JOIN\" \"PART\")." @@ -151,6 +157,16 @@ :type '(choice (const :tag "Disabled") function)) +(defcustom erc-track-list-changed-hook nil + "Hook that is run whenever the contents of +`erc-modified-channels-alist' changes. + +This is useful for people that don't use the default mode-line +notification but instead use a separate mechanism to provide +notification of channel activity." + :group 'erc-track + :type 'hook) + (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. @@ -192,12 +208,14 @@ 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'." +t - add to the end of `global-mode-string'. +nil - don't add to mode line +" :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)) + (const :tag "After all other information" t) + (const :tag "Don't display in mode line" nil)) :set (lambda (sym val) (set sym val) (when (and (boundp 'erc-track-mode) @@ -263,12 +281,14 @@ (defcustom erc-track-switch-direction 'oldest "Direction `erc-track-switch-buffer' should switch. + importance - find buffer with the most important message 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) + :type '(choice (const importance) + (const oldest) (const newest) (const leastactive) (const mostactive))) @@ -296,7 +316,7 @@ (boundp 'mode-line-modes)) (add-to-list 'mode-line-modes '(t erc-modified-channels-object) t)) - (t + ((eq position t) (when (not global-mode-string) (setq global-mode-string '(""))) ; Padding for mode-line wart (add-to-list 'global-mode-string @@ -644,14 +664,21 @@ (setq erc-buffer-activity (erc-current-time)) (erc-track-modified-channels)) +(defun erc-track-get-buffer-window (buffer frame-param) + (if (eq frame-param 'selected-visible) + (if (eq (frame-visible-p (selected-frame)) t) + (get-buffer-window buffer nil) + nil) + (get-buffer-window buffer frame-param))) + (defun erc-buffer-visible (buffer) "Return non-nil when the buffer is visible." (if erc-track-when-inactive (when erc-buffer-activity; could be nil - (and (get-buffer-window buffer erc-track-visibility) + (and (erc-track-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))) + (erc-track-get-buffer-window buffer erc-track-visibility))) ;;; Tracking the channel modifications @@ -668,18 +695,22 @@ ARGS are ignored." (interactive) (unless erc-modified-channels-update-inside - (let ((erc-modified-channels-update-inside t)) + (let ((erc-modified-channels-update-inside t) + (removed-channel nil)) (mapcar (lambda (elt) (let ((buffer (car elt))) (when (or (not (bufferp buffer)) (not (buffer-live-p buffer)) (erc-buffer-visible buffer) + (and erc-track-remove-disconnected-buffers (not (with-current-buffer buffer - erc-server-connected))) + erc-server-connected)))) + (setq removed-channel t) (erc-modified-channels-remove-buffer buffer)))) erc-modified-channels-alist) + (when removed-channel (erc-modified-channels-display) - (force-mode-line-update t)))) + (force-mode-line-update t))))) (defvar erc-track-mouse-face (if (featurep 'xemacs) 'modeline-mousable @@ -729,10 +760,13 @@ "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)) + (cond ((or (eq 'mostactive erc-track-switch-direction) + (eq 'leastactive erc-track-switch-direction)) + (erc-track-sort-by-activest)) + ((eq 'importance erc-track-switch-direction) + (erc-track-sort-by-importance))) + (run-hooks 'erc-track-list-changed-hook) + (unless (eq erc-track-position-in-mode-line nil) (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 @@ -768,7 +802,7 @@ (when (featurep 'xemacs) (erc-modified-channels-object nil)) (setq erc-modified-channels-object - (erc-modified-channels-object strings))))) + (erc-modified-channels-object strings)))))) (defun erc-modified-channels-remove-buffer (buffer) "Remove BUFFER from `erc-modified-channels-alist'." @@ -802,8 +836,7 @@ (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))))) + (erc-server-buffer-p))) (not (erc-message-type-member (or (erc-find-parsed-property) (point-min)) @@ -847,10 +880,10 @@ (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)) + (when (and (or (erc-buffer-visible (current-buffer)) (and this-channel - (assq (current-buffer) erc-modified-channels-alist) (member this-channel erc-track-exclude))) + (assq (current-buffer) erc-modified-channels-alist)) ;; 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)) @@ -887,6 +920,29 @@ (sort erc-modified-channels-alist (lambda (a b) (> (nth 1 a) (nth 1 b)))))) +(defun erc-track-face-priority (face) + "Return a number indicating the priority of FACE in +`erc-track-faces-priority-list'. Lower number means higher +priority. + +If face is not in `erc-track-faces-priority-list', it will have a +higher number than any other face in that list." + (let ((count 0)) + (catch 'done + (dolist (item erc-track-faces-priority-list) + (if (eq item face) + (throw 'done t) + (setq count (1+ count))))) + count)) + +(defun erc-track-sort-by-importance () + "Sort erc-modified-channels-alist by importance. +That means the position of the face in `erc-track-faces-priority-list'." + (setq erc-modified-channels-alist + (sort erc-modified-channels-alist + (lambda (a b) (< (erc-track-face-priority (cddr a)) + (erc-track-face-priority (cddr 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 @@ -898,7 +954,8 @@ (oldest 'newest) (newest 'oldest) (mostactive 'leastactive) - (leastactive 'mostactive))) + (leastactive 'mostactive) + (importance 'oldest))) (setq arg (- arg))) (setq offset (case dir ((oldest leastactive)
--- a/lisp/erc/erc.el Sat Sep 08 01:38:27 2007 +0000 +++ b/lisp/erc/erc.el Sat Sep 08 03:07:09 2007 +0000 @@ -66,7 +66,7 @@ ;;; Code: -(defconst erc-version-string "Version 5.2" +(defconst erc-version-string "Version 5.3 (devel)" "ERC version. This is used by function `erc-version'.") (eval-when-compile (require 'cl)) @@ -836,8 +836,9 @@ ;; Script parameters (defcustom erc-startup-file-list - '("~/.emacs.d/.ercrc.el" "~/.emacs.d/.ercrc" - "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") + (list (concat erc-user-emacs-directory ".ercrc.el") + (concat erc-user-emacs-directory ".ercrc") + "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") "List of files to try for a startup script. The first existent and readable one will get executed. @@ -1460,7 +1461,7 @@ (defconst erc-default-server "irc.freenode.net" "IRC server to use if it cannot be detected otherwise.") -(defconst erc-default-port "6667" +(defconst erc-default-port 6667 "IRC port to use if it cannot be detected otherwise.") (defcustom erc-join-buffer 'buffer @@ -1491,6 +1492,14 @@ :group 'erc-buffers :type 'boolean) +(defcustom erc-reuse-frames t + "*Determines whether new frames are always created. +Non-nil means that a new frame is not created to display an ERC +buffer if there is already a window displaying it. This only has +effect when `erc-join-buffer' is set to `frame'." + :group 'erc-buffers + :type 'boolean) + (defun erc-channel-p (channel) "Return non-nil if CHANNEL seems to be an IRC channel name." (cond ((stringp channel) @@ -1888,14 +1897,16 @@ ((eq erc-join-buffer 'bury) nil) ((eq erc-join-buffer 'frame) - (funcall '(lambda (frame) + (when (or (not erc-reuse-frames) + (not (get-buffer-window buffer t))) + ((lambda (frame) (raise-frame frame) (select-frame frame)) (make-frame (or erc-frame-alist default-frame-alist))) (switch-to-buffer buffer) (when erc-frame-dedicated-flag - (set-window-dedicated-p (selected-window) t))) + (set-window-dedicated-p (selected-window) t)))) (t (if (active-minibuffer-window) (display-buffer buffer) @@ -2155,16 +2166,48 @@ "Open an SSL stream to an IRC server. The process will be given the name NAME, its target buffer will be BUFFER. HOST and PORT specify the connection target." - (when (require 'tls) - (let ((proc (open-tls-stream name buffer host port))) + (when (condition-case nil + (require 'ssl) + (error (message "You don't have ssl.el. %s" + "Try using `erc-tls' instead.") + nil)) + (let ((proc (open-ssl-stream name buffer host port))) ;; Ugly hack, but it works for now. Problem is it is ;; very hard to detect when ssl is established, because s_client ;; doesn't give any CONNECTIONESTABLISHED kind of message, and ;; most IRC servers send nothing and wait for you to identify. - ;; Disabled when switching to tls.el -- jas - ;(sit-for 5) + (sit-for 5) proc))) +(defun erc-tls (&rest r) + "Interactively select TLS connection parameters and run ERC. +Arguments are the same as for `erc'." + (interactive (erc-select-read-args)) + (let ((erc-server-connect-function 'erc-open-tls-stream)) + (apply 'erc r))) + +(defun erc-open-tls-stream (name buffer host port) + "Open an TLS stream to an IRC server. +The process will be given the name NAME, its target buffer will be +BUFFER. HOST and PORT specify the connection target." + (when (condition-case nil + (require 'tls) + (error (message "You don't have tls.el. %s" + "Try using `erc-ssl' instead.") + nil)) + (open-tls-stream name buffer host port))) + +;;; Displaying error messages + +(defun erc-error (&rest args) + "Pass ARGS to `format', and display the result as an error message. +If `debug-on-error' is set to non-nil, then throw a real error with this +message instead, to make debugging easier." + (if debug-on-error + (apply #'error args) + (apply #'message args) + (beep))) + ;;; Debugging the protocol (defvar erc-debug-irc-protocol nil @@ -2456,6 +2499,14 @@ (match-string 1 arglist) arglist))) +(defun erc-command-no-process-p (str) + "Return non-nil if STR is an ERC command that can be run when the process +is not alive, nil otherwise." + (let ((fun (erc-extract-command-from-line str))) + (and fun + (symbolp (car fun)) + (get (car fun) 'process-not-needed)))) + (defun erc-command-name (cmd) "For CMD being the function name of a ERC command, something like erc-cmd-FOO, this returns a string /FOO." @@ -2565,6 +2616,7 @@ (defalias 'erc-cmd-VAR 'erc-cmd-SET) (defalias 'erc-cmd-VARIABLE 'erc-cmd-SET) (put 'erc-cmd-SET 'do-not-parse-args t) +(put 'erc-cmd-SET 'process-not-needed t) (defun erc-cmd-default (line) "Fallback command. @@ -2623,6 +2675,7 @@ "Clear the window content." (recenter 0) t) +(put 'erc-cmd-CLEAR 'process-not-needed t) (defun erc-cmd-OPS () "Show the ops in the current channel." @@ -2656,6 +2709,7 @@ (erc-display-message nil 'notice 'active 'country-unknown ?d tld)) t)) +(put 'erc-cmd-COUNTRY 'process-not-needed t) (defun erc-cmd-AWAY (line) "Mark the user as being away, the reason being indicated by LINE. @@ -2736,6 +2790,7 @@ t)) (defalias 'erc-cmd-H 'erc-cmd-HELP) +(put 'erc-cmd-HELP 'process-not-needed t) (defun erc-cmd-JOIN (channel &optional key) "Join the channel given in CHANNEL, optionally with KEY. @@ -2973,6 +3028,7 @@ (occur line) t) (put 'erc-cmd-LASTLOG 'do-not-parse-args t) +(put 'erc-cmd-LASTLOG 'process-not-needed t) (defun erc-send-message (line &optional force) "Send LINE to the current channel or user and display it. @@ -3195,20 +3251,34 @@ (defalias 'erc-cmd-EXIT 'erc-cmd-QUIT) (defalias 'erc-cmd-SIGNOFF 'erc-cmd-QUIT) (put 'erc-cmd-QUIT 'do-not-parse-args t) +(put 'erc-cmd-QUIT 'process-not-needed t) (defun erc-cmd-GQUIT (reason) "Disconnect from all servers at once with the same quit REASON." (erc-with-all-buffers-of-server nil #'erc-open-server-buffer-p - (erc-cmd-QUIT reason))) + (erc-cmd-QUIT reason)) + (when erc-kill-queries-on-quit + ;; if the query buffers have not been killed within 4 seconds, + ;; kill them + (run-at-time + 4 nil + (lambda () + (dolist (buffer (erc-buffer-list (lambda (buf) + (not (erc-server-buffer-p buf))))) + (kill-buffer buffer))))) + t) (defalias 'erc-cmd-GQ 'erc-cmd-GQUIT) (put 'erc-cmd-GQUIT 'do-not-parse-args t) +(put 'erc-cmd-GQUIT 'process-not-needed t) (defun erc-cmd-RECONNECT () "Try to reconnect to the current IRC server." - (let ((buffer (or (erc-server-buffer) (current-buffer))) + (let ((buffer (erc-server-buffer)) (process nil)) - (with-current-buffer (if (bufferp buffer) buffer (current-buffer)) + (unless (buffer-live-p buffer) + (setq buffer (current-buffer))) + (with-current-buffer buffer (setq erc-server-quitting nil) (setq erc-server-reconnecting t) (setq erc-server-reconnect-count 0) @@ -3218,6 +3288,7 @@ (erc-server-reconnect)) (setq erc-server-reconnecting nil))) t) +(put 'erc-cmd-RECONNECT 'process-not-needed t) (defun erc-cmd-SERVER (server) "Connect to SERVER, leaving existing connection intact." @@ -3225,9 +3296,9 @@ (condition-case nil (erc :server server :nick (erc-current-nick)) (error - (message "Cannot find host %s." server) - (beep))) + (erc-error "Cannot find host %s." server))) t) +(put 'erc-cmd-SERVER 'process-not-needed t) (eval-when-compile (defvar motif-version-string) @@ -4411,33 +4482,65 @@ erc-channel-users) (setq erc-channel-new-member-names nil)) +(defun erc-parse-prefix () + "Return an alist of valid prefix character types and their representations. +Example: (operator) o => @, (voiced) v => +." + (let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer + erc-server-parameters))) + ;; provide a sane default + "(ov)@+")) + types chars) + (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str) + (setq types (match-string 1 str) + chars (match-string 2 str)) + (let ((len (min (length types) (length chars))) + (i 0) + (alist nil)) + (while (< i len) + (setq alist (cons (cons (elt types i) (elt chars i)) + alist)) + (setq i (1+ i))) + alist)))) + (defun erc-channel-receive-names (names-string) "This function is for internal use only. Update `erc-channel-users' according to NAMES-STRING. NAMES-STRING is a string listing some of the names on the channel." - (let (names name op voice) - ;; We need to delete "" because in XEmacs, (split-string "a ") - ;; returns ("a" ""). - (setq names (delete "" (split-string names-string))) - (let ((erc-channel-members-changed-hook nil)) - (dolist (item names) - (cond ((string-match "^@\\(.*\\)$" item) - (setq name (match-string 1 item) - op 'on - voice 'off)) - ((string-match "^+\\(.*\\)$" item) - (setq name (match-string 1 item) - op 'off - voice 'on)) - (t (setq name item - op 'off - voice 'off))) - (puthash (erc-downcase name) t - erc-channel-new-member-names) - (erc-update-current-channel-member - name name t op voice))) + (let (prefix op-ch voice-ch names name op voice) + (setq prefix (erc-parse-prefix)) + (setq op-ch (cdr (assq ?o prefix)) + voice-ch (cdr (assq ?v prefix))) + ;; We need to delete "" because in XEmacs, (split-string "a ") + ;; returns ("a" ""). + (setq names (delete "" (split-string names-string))) + (let ((erc-channel-members-changed-hook nil)) + (dolist (item names) + (let ((updatep t) + ch) + (if (rassq (elt item 0) prefix) + (cond ((= (length item) 1) + (setq updatep nil)) + ((eq (elt item 0) op-ch) + (setq name (substring item 1) + op 'on + voice 'off)) + ((eq (elt item 0) voice-ch) + (setq name (substring item 1) + op 'off + voice 'on)) + (t (setq name (substring item 1) + op 'off + voice 'off))) + (setq name item + op 'off + voice 'off)) + (when updatep + (puthash (erc-downcase name) t + erc-channel-new-member-names) + (erc-update-current-channel-member + name name t op voice))))) (run-hooks 'erc-channel-members-changed-hook))) (defcustom erc-channel-members-changed-hook nil @@ -4529,15 +4632,15 @@ (setq changed t) (setf (erc-channel-user-op cuser) (cond ((eq op 'on) t) - ((eq op 'off) nil) - (t op)))) + ((eq op 'off) nil) + (t op)))) (when (and voice (not (eq (erc-channel-user-voice cuser) voice))) (setq changed t) (setf (erc-channel-user-voice cuser) (cond ((eq voice 'on) t) - ((eq voice 'off) nil) - (t voice)))) + ((eq voice 'off) nil) + (t voice)))) (when update-message-time (setf (erc-channel-user-last-message-time cuser) (current-time))) (setq user-changed @@ -4559,11 +4662,11 @@ (erc-server-user-buffers user)))) (setq cuser (make-erc-channel-user :op (cond ((eq op 'on) t) - ((eq op 'off) nil) - (t op)) + ((eq op 'off) nil) + (t op)) :voice (cond ((eq voice 'on) t) - ((eq voice 'off) nil) - (t voice)) + ((eq voice 'off) nil) + (t voice)) :last-message-time (if update-message-time (current-time)))) (puthash (erc-downcase nick) (cons user cuser) @@ -4892,39 +4995,37 @@ (interactive) (save-restriction (widen) - (cond - ((< (point) (erc-beg-of-input-line)) - (message "Point is not in the input area") - (beep)) - ((not (erc-server-buffer-live-p)) - (message "ERC: No process running") - (beep)) - (t - (erc-set-active-buffer (current-buffer)) + (if (< (point) (erc-beg-of-input-line)) + (erc-error "Point is not in the input area") (let ((inhibit-read-only t) (str (erc-user-input)) (old-buf (current-buffer))) - - ;; Kill the input and the prompt - (delete-region (erc-beg-of-input-line) - (erc-end-of-input-line)) - - (unwind-protect - (erc-send-input str) - ;; Fix the buffer if the command didn't kill it - (when (buffer-live-p old-buf) - (with-current-buffer old-buf - (save-restriction - (widen) - (goto-char (point-max)) - (set-marker (process-mark erc-server-process) (point)) - (set-marker erc-insert-marker (point)) - (let ((buffer-modified (buffer-modified-p))) - (erc-display-prompt) - (set-buffer-modified-p buffer-modified)))))) - - ;; Only when last hook has been run... - (run-hook-with-args 'erc-send-completed-hook str)))))) + (if (and (not (erc-server-buffer-live-p)) + (not (erc-command-no-process-p str))) + (erc-error "ERC: No process running") + (erc-set-active-buffer (current-buffer)) + + ;; Kill the input and the prompt + (delete-region (erc-beg-of-input-line) + (erc-end-of-input-line)) + + (unwind-protect + (erc-send-input str) + ;; Fix the buffer if the command didn't kill it + (when (buffer-live-p old-buf) + (with-current-buffer old-buf + (save-restriction + (widen) + (goto-char (point-max)) + (when (processp erc-server-process) + (set-marker (process-mark erc-server-process) (point))) + (set-marker erc-insert-marker (point)) + (let ((buffer-modified (buffer-modified-p))) + (erc-display-prompt) + (set-buffer-modified-p buffer-modified)))))) + + ;; Only when last hook has been run... + (run-hook-with-args 'erc-send-completed-hook str)))))) (defun erc-user-input () "Return the input of the user in the current buffer." @@ -4985,7 +5086,8 @@ (erc-put-text-property beg (point) 'face 'erc-command-indicator-face) (insert "\n")) - (set-marker (process-mark erc-server-process) (point)) + (when (processp erc-server-process) + (set-marker (process-mark erc-server-process) (point))) (set-marker erc-insert-marker (point)) (save-excursion (save-restriction @@ -5004,7 +5106,8 @@ (erc-put-text-property beg (point) 'face 'erc-input-face)) (insert "\n") - (set-marker (process-mark erc-server-process) (point)) + (when (processp erc-server-process) + (set-marker (process-mark erc-server-process) (point))) (set-marker erc-insert-marker (point)) (save-excursion (save-restriction