From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Ryan Yeske Newsgroups: gmane.emacs.devel Subject: rcirc update Date: Fri, 08 Jun 2007 22:21:52 -0700 Message-ID: <871wgld7nz.fsf@owie.lan> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: sea.gmane.org 1181366576 20040 80.91.229.12 (9 Jun 2007 05:22:56 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sat, 9 Jun 2007 05:22:56 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Jun 09 07:22:49 2007 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.50) id 1HwtPR-0006L0-RP for ged-emacs-devel@m.gmane.org; Sat, 09 Jun 2007 07:22:47 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1HwtPQ-0003lW-M9 for ged-emacs-devel@m.gmane.org; Sat, 09 Jun 2007 01:22:44 -0400 Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1HwtPJ-0003lR-75 for emacs-devel@gnu.org; Sat, 09 Jun 2007 01:22:37 -0400 Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1HwtPH-0003l3-3k for emacs-devel@gnu.org; Sat, 09 Jun 2007 01:22:36 -0400 Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1HwtPG-0003l0-VV for emacs-devel@gnu.org; Sat, 09 Jun 2007 01:22:35 -0400 Original-Received: from mail.tor.primus.ca ([216.254.136.21] helo=mail-02.primus.ca) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1HwtPG-0003oF-39 for emacs-devel@gnu.org; Sat, 09 Jun 2007 01:22:34 -0400 Original-Received: from [209.90.177.161] (helo=owie.lan) by mail-02.primus.ca with esmtp (Exim 4.63) (envelope-from ) id 1HwtPD-0002SW-2x for emacs-devel@gnu.org; Sat, 09 Jun 2007 01:22:33 -0400 X-detected-kernel: Linux 2.6, seldom 2.4 (older, 4) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:72529 Archived-At: 2007-06-08 Ryan Yeske * rcirc.el (rcirc-format-response-string): Use rcirc-nick-syntax around bright and dim regexps. Make sure bright and dim matches use word anchors. Send text through rcirc-markup functions. (rcirc-url-regexp): Add single quote character. (rcirc-connect): Write logs to disk on auto-save-hook. Make server a non-optional argument. (rcirc-log-alist): New variable. (rcirc-log-directory): Make customizable. (rcirc-log-flag): New customizable variable. (rcirc-log): New function. (rcirc-print): Use above function. (rcirc-log-write): New function. (rcirc-generate-new-buffer-name): Strip text properties. (rcirc-switch-to-buffer-function): Remove variable. (rcirc-last-non-irc-buffer): Remove variable. (rcirc-non-irc-buffer): Add function. (rcirc-next-active-buffer): Use above function. (rcirc-keepalive): Send KEEPALIVE ctcp instead of a PING. (rcirc-handler-ctcp-KEEPALIVE): Add handler. (rcirc-handler-CTCP): Don't print KEEPALIVE responses. (rcirc-omit-mode): Add minor-mode. (rcirc-mode-map): Change C-c C-o binding. (rcirc-mode): Clear mode-line-process. Use a custom fill-paragraph-function. Set up buffer-invisibility-spec. (rcirc-response-formats): Remove timestamp code. (rcirc-omit-responses): Add variable. (rcirc-print): Don't put the overlay arrow on potentially omitted lines. Log line to disk. Record activity for private messages from /dim nicks. Facify the fill-prefix with rcirc-timestamp face. (rcirc-jump-to-first-unread-line): Print message if there is no unread text. (rcirc-clear-unread): New function. (rcirc-markup-text-functions): Add variable. (rcirc-markup-timestamp, rcirc-markup-fill): Add functions. (rcirc-debug): Don't mess with window configuration. (rcirc-send-message): Send message before printing locally. Add SILENT argument, do not print message if non-nil. (rcirc-visible-buffers): New function and variable. (rcirc-window-configuration-change-1): Add function. (rcirc-target-buffer): Make sure ACTIONs don't get sent to the server buffer. (rcirc-clean-up-buffer): Set rcirc-target to nil when finished. (rcirc-fill-paragraph): Add function. (rcirc-record-activity, rcirc-window-configuration-change-1): Only update the activity string if it has actually changed. (rcirc-update-activity-string): Remove padding characters from the mode-line string. (rcirc-disconnect-buffer): New function to be called when a channel is parted or the user quits. (rcirc-server-name): Warn when the server-name hasn't been set. (rcirc-window-configuration-change): Postpone work until post-command-hook. (rcirc-window-configuration-change-1): Update mode-line and overlay arrows here. (rcirc-authenticate): Fix chanserv identification. (rcirc-default-server): Remove variable. (rcirc): Connect according to rcirc-connections. (rcirc-connections): Add variable. (rcirc-startup-channels-alist): Remove variable. (rcirc-startup-channels): Remove function. Index: rcirc.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/net/rcirc.el,v retrieving revision 1.32.2.2 diff -c -r1.32.2.2 rcirc.el *** rcirc.el 21 May 2007 19:38:52 -0000 1.32.2.2 --- rcirc.el 9 Jun 2007 05:10:29 -0000 *************** *** 55,63 **** :link '(custom-manual "(rcirc)") :group 'applications) ! (defcustom rcirc-default-server "irc.freenode.net" ! "The default server to connect to." ! :type 'string :group 'rcirc) (defcustom rcirc-default-port 6667 --- 55,78 ---- :link '(custom-manual "(rcirc)") :group 'applications) ! (defcustom rcirc-connections ! '(("irc.freenode.net" :channels ("#rcirc"))) ! "An alist of IRC connections to establish when running `rcirc'. ! Each element looks like (SERVER-NAME PARAMETERS). ! ! SERVER-NAME is a string describing the server to connect ! to. ! ! PARAMETERS is a plist of optional connection parameters. Valid ! properties are: nick (a string), port (number or string), ! user-name (string), full-name (string), and channels (list of ! strings)." ! :type '(alist :key-type string ! :value-type (plist :options ((nick string) ! (port integer) ! (user-name string) ! (full-name string) ! (channels (repeat string))))) :group 'rcirc) (defcustom rcirc-default-port 6667 *************** *** 82,93 **** :type 'string :group 'rcirc) - (defcustom rcirc-startup-channels-alist '(("^irc.freenode.net$" "#rcirc")) - "Alist of channels to join at startup. - Each element looks like (SERVER-REGEXP . CHANNEL-LIST)." - :type '(alist :key-type string :value-type (repeat string)) - :group 'rcirc) - (defcustom rcirc-fill-flag t "*Non-nil means line-wrap messages printed in channel buffers." :type 'boolean --- 97,102 ---- *************** *** 95,105 **** (defcustom rcirc-fill-column nil "*Column beyond which automatic line-wrapping should happen. ! If nil, use value of `fill-column'. ! If `window-width', use the window's width as maximum. ! If `frame-width', use the frame's width as maximum." :type '(choice (const :tag "Value of `fill-column'") - (const :tag "Full window width" window-width) (const :tag "Full frame width" frame-width) (integer :tag "Number of columns")) :group 'rcirc) --- 104,112 ---- (defcustom rcirc-fill-column nil "*Column beyond which automatic line-wrapping should happen. ! If nil, use value of `fill-column'. If 'frame-width, use the ! maximum frame width." :type '(choice (const :tag "Value of `fill-column'") (const :tag "Full frame width" frame-width) (integer :tag "Number of columns")) :group 'rcirc) *************** *** 120,125 **** --- 127,137 ---- "If non-nil, activity in this buffer is considered low priority.") (make-variable-buffer-local 'rcirc-low-priority-flag) + (defvar rcirc-omit-mode nil + "Non-nil if Rcirc-Omit mode is enabled. + Use the command `rcirc-omit-mode' to change this variable.") + (make-variable-buffer-local 'rcirc-omit-mode) + (defcustom rcirc-time-format "%H:%M " "*Describes how timestamps are printed. Used as the first arg to `format-time-string'." *************** *** 145,151 **** :group 'rcirc) (defcustom rcirc-scroll-show-maximum-output t ! "*If non-nil, scroll buffer to keep the point at the bottom of the window." :type 'boolean :group 'rcirc) --- 157,164 ---- :group 'rcirc) (defcustom rcirc-scroll-show-maximum-output t ! "*If non-nil, scroll buffer to keep the point at the bottom of ! the window." :type 'boolean :group 'rcirc) *************** *** 319,354 **** (defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version)) (defvar rcirc-startup-channels nil) ;;;###autoload (defun rcirc (arg) ! "Connect to IRC. ! If ARG is non-nil, prompt for a server to connect to." (interactive "P") (if arg ! (let* ((server (read-string "IRC Server: " rcirc-default-server)) ! (port (read-string "IRC Port: " (number-to-string rcirc-default-port))) ! (nick (read-string "IRC Nick: " rcirc-default-nick)) (channels (split-string (read-string "IRC Channels: " ! (mapconcat 'identity (rcirc-startup-channels server) " ")) "[, ]+" t))) ! (rcirc-connect server port nick rcirc-default-user-name rcirc-default-user-full-name channels)) ! ;; make new connection using defaults unless already connected to ! ;; the default rcirc-server ! (let (connected) ! (dolist (p (rcirc-process-list)) ! (when (string= rcirc-default-server (process-name p)) ! (setq connected p))) ! (if (not connected) ! (rcirc-connect rcirc-default-server rcirc-default-port ! rcirc-default-nick rcirc-default-user-name ! rcirc-default-user-full-name ! (rcirc-startup-channels rcirc-default-server)) ! (switch-to-buffer (process-buffer connected)) ! (message "Connected to %s" ! (process-contact (get-buffer-process (current-buffer)) ! :host)))))) ;;;###autoload (defalias 'irc 'rcirc) --- 332,400 ---- (defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version)) (defvar rcirc-startup-channels nil) + ;;;###autoload (defun rcirc (arg) ! "Connect to all servers in `rcirc-connections'. ! ! Do not connect to a server if it is already connected. ! ! If ARG is non-nil, instead prompt for connection parameters." (interactive "P") (if arg ! (let* ((server (completing-read "IRC Server: " ! rcirc-connections ! nil nil ! (caar rcirc-connections))) ! (server-plist (cdr (assoc-string server rcirc-connections))) ! (port (read-string "IRC Port: " ! (number-to-string ! (or (plist-get server-plist 'port) ! rcirc-default-port)))) ! (nick (read-string "IRC Nick: " ! (or (plist-get server-plist 'nick) ! rcirc-default-nick))) (channels (split-string (read-string "IRC Channels: " ! (mapconcat 'identity ! (plist-get server-plist ! 'channels) ! " ")) "[, ]+" t))) ! (rcirc-connect server port nick rcirc-default-user-name ! rcirc-default-user-full-name channels)) ! ;; connect to servers in `rcirc-connections' ! (let (connected-servers) ! (dolist (c rcirc-connections) ! (let ((server (car c)) ! (port (or (plist-get (cdr c) 'port) rcirc-default-port)) ! (nick (or (plist-get (cdr c) 'nick) rcirc-default-nick)) ! (user-name (or (plist-get (cdr c) 'user-name) ! rcirc-default-user-name)) ! (full-name (or (plist-get (cdr c) 'full-name) ! rcirc-default-user-full-name)) ! (channels (plist-get (cdr c) 'channels))) ! (when server ! (let (connected) ! (dolist (p (rcirc-process-list)) ! (when (string= server (process-name p)) ! (setq connected p))) ! (if (not connected) ! (condition-case e ! (rcirc-connect server port nick user-name ! full-name channels) ! (quit (message "Quit connecting to %s" server))) ! (with-current-buffer (process-buffer connected) ! (setq connected-servers ! (cons (process-contact (get-buffer-process ! (current-buffer)) :host) ! connected-servers)))))))) ! (when connected-servers ! (message "Already connected to %s" ! (concat (mapconcat 'identity (butlast connected-servers) ", ") ! ", and " (car (last connected-servers)))))))) ! ;;;###autoload (defalias 'irc 'rcirc) *************** *** 365,371 **** (defvar rcirc-process nil) ;;;###autoload ! (defun rcirc-connect (&optional server port nick user-name full-name startup-channels) (save-excursion (message "Connecting to %s..." server) (let* ((inhibit-eol-conversion) --- 411,418 ---- (defvar rcirc-process nil) ;;;###autoload ! (defun rcirc-connect (server &optional port nick user-name full-name ! startup-channels) (save-excursion (message "Connecting to %s..." server) (let* ((inhibit-eol-conversion) *************** *** 374,380 **** (string-to-number port) port) rcirc-default-port)) - (server (or server rcirc-default-server)) (nick (or nick rcirc-default-nick)) (user-name (or user-name rcirc-default-user-name)) (full-name (or full-name rcirc-default-user-full-name)) --- 421,426 ---- *************** *** 412,417 **** --- 458,465 ---- (make-local-variable 'rcirc-connecting) (setq rcirc-connecting t) + (add-hook 'auto-save-hook 'rcirc-log-write) + ;; identify (rcirc-send-string process (concat "NICK " nick)) (rcirc-send-string process (concat "USER " user-name *************** *** 446,457 **** (mapc (lambda (process) (with-rcirc-process-buffer process (when (not rcirc-connecting) ! (rcirc-send-string process (concat "PING " (rcirc-server-name process)))))) (rcirc-process-list)) ;; no processes, clean up timer (cancel-timer rcirc-keepalive-timer) (setq rcirc-keepalive-timer nil))) (defvar rcirc-debug-buffer " *rcirc debug*") (defvar rcirc-debug-flag nil "If non-nil, write information to `rcirc-debug-buffer'.") --- 494,514 ---- (mapc (lambda (process) (with-rcirc-process-buffer process (when (not rcirc-connecting) ! (rcirc-send-string process ! (format "PRIVMSG %s :\C-aKEEPALIVE %f\C-a" ! rcirc-nick ! (time-to-seconds ! (current-time))))))) (rcirc-process-list)) ;; no processes, clean up timer (cancel-timer rcirc-keepalive-timer) (setq rcirc-keepalive-timer nil))) + (defun rcirc-handler-ctcp-KEEPALIVE (process target sender message) + (with-rcirc-process-buffer process + (setq header-line-format (format "%f" (- (time-to-seconds (current-time)) + (string-to-number message)))))) + (defvar rcirc-debug-buffer " *rcirc debug*") (defvar rcirc-debug-flag nil "If non-nil, write information to `rcirc-debug-buffer'.") *************** *** 461,474 **** is non-nil." (when rcirc-debug-flag (save-excursion ! (save-window-excursion ! (set-buffer (get-buffer-create rcirc-debug-buffer)) ! (goto-char (point-max)) ! (insert (concat ! "[" ! (format-time-string "%Y-%m-%dT%T ") (process-name process) ! "] " ! text)))))) (defvar rcirc-sentinel-hooks nil "Hook functions called when the process sentinel is called. --- 518,530 ---- is non-nil." (when rcirc-debug-flag (save-excursion ! (set-buffer (get-buffer-create rcirc-debug-buffer)) ! (goto-char (point-max)) ! (insert (concat ! "[" ! (format-time-string "%Y-%m-%dT%T ") (process-name process) ! "] " ! text))))) (defvar rcirc-sentinel-hooks nil "Hook functions called when the process sentinel is called. *************** *** 486,497 **** (process-name process) sentinel (process-status process)) (not rcirc-target)) ! ;; remove the prompt from buffers ! (let ((inhibit-read-only t)) ! (delete-region rcirc-prompt-start-marker ! rcirc-prompt-end-marker)))) (run-hook-with-args 'rcirc-sentinel-hooks process sentinel)))) (defun rcirc-process-list () "Return a list of rcirc processes." (let (ps) --- 542,557 ---- (process-name process) sentinel (process-status process)) (not rcirc-target)) ! (rcirc-disconnect-buffer))) (run-hook-with-args 'rcirc-sentinel-hooks process sentinel)))) + (defun rcirc-disconnect-buffer (&optional buffer) + (with-current-buffer (or buffer (current-buffer)) + ;; set rcirc-target to nil for each channel so cleanup + ;; doesnt happen when we reconnect + (setq rcirc-target nil) + (setq mode-line-process ":disconnected"))) + (defun rcirc-process-list () "Return a list of rcirc processes." (let (ps) *************** *** 593,599 **** (defun rcirc-server-name (process) "Return PROCESS server name, given by the 001 response." (with-rcirc-process-buffer process ! (or rcirc-server-name rcirc-default-server))) (defun rcirc-nick (process) "Return PROCESS nick." --- 653,660 ---- (defun rcirc-server-name (process) "Return PROCESS server name, given by the 001 response." (with-rcirc-process-buffer process ! (or rcirc-server-name ! (warn "server name for process %S unknown" process)))) (defun rcirc-nick (process) "Return PROCESS nick." *************** *** 610,618 **** (defvar rcirc-max-message-length 420 "Messages longer than this value will be split.") ! (defun rcirc-send-message (process target message &optional noticep) "Send TARGET associated with PROCESS a privmsg with text MESSAGE. ! If NOTICEP is non-nil, send a notice instead of privmsg." ;; max message length is 512 including CRLF (let* ((response (if noticep "NOTICE" "PRIVMSG")) (oversize (> (length message) rcirc-max-message-length)) --- 671,680 ---- (defvar rcirc-max-message-length 420 "Messages longer than this value will be split.") ! (defun rcirc-send-message (process target message &optional noticep silent) "Send TARGET associated with PROCESS a privmsg with text MESSAGE. ! If NOTICEP is non-nil, send a notice instead of privmsg. ! If SILENT is non-nil, do not print the message in any irc buffer." ;; max message length is 512 including CRLF (let* ((response (if noticep "NOTICE" "PRIVMSG")) (oversize (> (length message) rcirc-max-message-length)) *************** *** 625,632 **** (more (if oversize (substring message rcirc-max-message-length)))) (rcirc-get-buffer-create process target) - (rcirc-print process (rcirc-nick process) response target text) (rcirc-send-string process (concat response " " target " :" text)) (when more (rcirc-send-message process target more noticep)))) (defvar rcirc-input-ring nil) --- 687,695 ---- (more (if oversize (substring message rcirc-max-message-length)))) (rcirc-get-buffer-create process target) (rcirc-send-string process (concat response " " target " :" text)) + (unless silent + (rcirc-print process (rcirc-nick process) response target text)) (when more (rcirc-send-message process target more noticep)))) (defvar rcirc-input-ring nil) *************** *** 711,717 **** (define-key rcirc-mode-map (kbd "C-c C-d") 'rcirc-cmd-mode) (define-key rcirc-mode-map (kbd "C-c C-m") 'rcirc-cmd-msg) (define-key rcirc-mode-map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename ! (define-key rcirc-mode-map (kbd "C-c C-o") 'rcirc-cmd-oper) (define-key rcirc-mode-map (kbd "C-c C-p") 'rcirc-cmd-part) (define-key rcirc-mode-map (kbd "C-c C-q") 'rcirc-cmd-query) (define-key rcirc-mode-map (kbd "C-c C-t") 'rcirc-cmd-topic) --- 774,780 ---- (define-key rcirc-mode-map (kbd "C-c C-d") 'rcirc-cmd-mode) (define-key rcirc-mode-map (kbd "C-c C-m") 'rcirc-cmd-msg) (define-key rcirc-mode-map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename ! (define-key rcirc-mode-map (kbd "C-c C-o") 'rcirc-omit-mode) (define-key rcirc-mode-map (kbd "C-c C-p") 'rcirc-cmd-part) (define-key rcirc-mode-map (kbd "C-c C-q") 'rcirc-cmd-query) (define-key rcirc-mode-map (kbd "C-c C-t") 'rcirc-cmd-topic) *************** *** 737,742 **** --- 800,809 ---- (defvar rcirc-last-post-time nil) + (defvar rcirc-log-alist nil + "Alist of lines to log to disk when `rcirc-log-flag' is non-nil. + Each element looks like (FILENAME . TEXT).") + (defun rcirc-mode (process target) "Major mode for IRC channel buffers. *************** *** 745,750 **** --- 812,818 ---- (use-local-map rcirc-mode-map) (setq mode-name "rcirc") (setq major-mode 'rcirc-mode) + (setq mode-line-process nil) (make-local-variable 'rcirc-input-ring) (setq rcirc-input-ring (make-ring rcirc-input-ring-size)) *************** *** 756,761 **** --- 824,831 ---- (setq rcirc-topic nil) (make-local-variable 'rcirc-last-post-time) (setq rcirc-last-post-time (current-time)) + (make-local-variable 'fill-paragraph-function) + (setq fill-paragraph-function 'rcirc-fill-paragraph) (make-local-variable 'rcirc-short-buffer-name) (setq rcirc-short-buffer-name nil) *************** *** 785,790 **** --- 855,862 ---- (setq overlay-arrow-position (make-marker)) (set-marker overlay-arrow-position nil) + (setq buffer-invisibility-spec '(rcirc-ignored-user)) + ;; if the user changes the major mode or kills the buffer, there is ;; cleanup work to do (add-hook 'change-major-mode-hook 'rcirc-change-major-mode-hook nil t) *************** *** 873,886 **** (when rcirc-target (rcirc-remove-nick-channel (rcirc-buffer-process) (rcirc-buffer-nick) ! rcirc-target)))))) (defun rcirc-generate-new-buffer-name (process target) "Return a buffer name based on PROCESS and TARGET. This is used for the initial name given to IRC buffers." ! (if target ! (concat target "@" (process-name process)) ! (concat "*" (process-name process) "*"))) (defun rcirc-get-buffer (process target &optional server) "Return the buffer associated with the PROCESS and TARGET. --- 945,960 ---- (when rcirc-target (rcirc-remove-nick-channel (rcirc-buffer-process) (rcirc-buffer-nick) ! rcirc-target)))) ! (setq rcirc-target nil))) (defun rcirc-generate-new-buffer-name (process target) "Return a buffer name based on PROCESS and TARGET. This is used for the initial name given to IRC buffers." ! (substring-no-properties ! (if target ! (concat target "@" (process-name process)) ! (concat "*" (process-name process) "*")))) (defun rcirc-get-buffer (process target &optional server) "Return the buffer associated with the PROCESS and TARGET. *************** *** 902,915 **** (when (not rcirc-target) (setq rcirc-target target)) buffer) ! ;; create the buffer ! (with-rcirc-process-buffer process ! (let ((new-buffer (get-buffer-create ! (rcirc-generate-new-buffer-name process target)))) ! (with-current-buffer new-buffer ! (rcirc-mode process target)) ! (rcirc-put-nick-channel process (rcirc-nick process) target) ! new-buffer))))) (defun rcirc-send-input () "Send input to target associated with the current buffer." --- 976,989 ---- (when (not rcirc-target) (setq rcirc-target target)) buffer) ! ;; create the buffer ! (with-rcirc-process-buffer process ! (let ((new-buffer (get-buffer-create ! (rcirc-generate-new-buffer-name process target)))) ! (with-current-buffer new-buffer ! (rcirc-mode process target)) ! (rcirc-put-nick-channel process (rcirc-nick process) target) ! new-buffer))))) (defun rcirc-send-input () "Send input to target associated with the current buffer." *************** *** 943,948 **** --- 1017,1030 ---- (ring-insert rcirc-input-ring input) (setq rcirc-input-ring-index 0)))))) + (defun rcirc-fill-paragraph (&optional arg) + (interactive "p") + (when (> (point) rcirc-prompt-end-marker) + (save-restriction + (narrow-to-region rcirc-prompt-end-marker (point-max)) + (let ((fill-column rcirc-max-message-length)) + (fill-region (point-min) (point-max)))))) + (defun rcirc-process-input-line (line) (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line) (rcirc-process-command (match-string 1 line) *************** *** 1021,1027 **** (defun rcirc-multiline-minor-submit () "Send the text in buffer back to parent buffer." (interactive) - (assert rcirc-parent-buffer) (untabify (point-min) (point-max)) (let ((text (buffer-substring (point-min) (point-max))) (buffer (current-buffer)) --- 1103,1108 ---- *************** *** 1052,1063 **** (process-buffer process))))) (defcustom rcirc-response-formats ! '(("PRIVMSG" . "%T<%N> %m") ! ("NOTICE" . "%T-%N- %m") ! ("ACTION" . "%T[%N %m]") ! ("COMMAND" . "%T%m") ! ("ERROR" . "%T%fw!!! %m") ! (t . "%T%fp*** %fs%n %r %m")) "An alist of formats used for printing responses. The format is looked up using the response-type as a key; if no match is found, the default entry (with a key of `t') is used. --- 1133,1144 ---- (process-buffer process))))) (defcustom rcirc-response-formats ! '(("PRIVMSG" . "<%N> %m") ! ("NOTICE" . "-%N- %m") ! ("ACTION" . "[%N %m]") ! ("COMMAND" . "%m") ! ("ERROR" . "%fw!!! %m") ! (t . "%fp*** %fs%n %r %m")) "An alist of formats used for printing responses. The format is looked up using the response-type as a key; if no match is found, the default entry (with a key of `t') is used. *************** *** 1069,1075 **** %n The sender's nick %N The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick') %r The response-type - %T The timestamp (with face `rcirc-timestamp') %t The target %fw Following text uses the face `font-lock-warning-face' %fp Following text uses the face `rcirc-server-prefix' --- 1150,1155 ---- *************** *** 1082,1173 **** :value-type string) :group 'rcirc) (defun rcirc-format-response-string (process sender response target text) "Return a nicely-formatted response string, incorporating TEXT \(and perhaps other arguments). The specific formatting used is found by looking up RESPONSE in `rcirc-response-formats'." ! (let ((chunks ! (split-string (or (cdr (assoc response rcirc-response-formats)) ! (cdr (assq t rcirc-response-formats))) ! "%")) ! (sender (or sender "")) ! (result "") ! (face nil) ! key face-key repl) ! (when (equal (car chunks) "") ! (pop chunks)) ! (dolist (chunk chunks) ! (if (equal chunk "") ! (setq key ?%) ! (setq key (aref chunk 0)) ! (setq chunk (substring chunk 1))) ! (setq repl ! (cond ((eq key ?%) ! ;; %% -- literal % character ! "%") ! ((or (eq key ?n) (eq key ?N)) ! ;; %n/%N -- nick ! (let ((nick (concat (if (string= (rcirc-server-name process) ! sender) ! "" ! sender) ! (and target (concat "," target))))) ! (rcirc-facify nick ! (if (eq key ?n) ! face ! (cond ((string= sender (rcirc-nick process)) ! 'rcirc-my-nick) ! ((and rcirc-bright-nicks ! (string-match ! (regexp-opt rcirc-bright-nicks) ! sender)) ! 'rcirc-bright-nick) ! ((and rcirc-dim-nicks ! (string-match ! (regexp-opt rcirc-dim-nicks) ! sender)) ! 'rcirc-dim-nick) ! (t ! 'rcirc-other-nick)))))) ! ((eq key ?T) ! ;; %T -- timestamp ! (rcirc-facify ! (format-time-string rcirc-time-format (current-time)) ! 'rcirc-timestamp)) ! ((eq key ?m) ! ;; %m -- message text ! (rcirc-markup-text process sender response (rcirc-facify text face))) ! ((eq key ?t) ! ;; %t -- target ! (rcirc-facify (or rcirc-target "") face)) ! ((eq key ?r) ! ;; %r -- response ! (rcirc-facify response face)) ! ((eq key ?f) ! ;; %f -- change face ! (setq face-key (aref chunk 0)) ! (setq chunk (substring chunk 1)) ! (cond ((eq face-key ?w) ! ;; %fw -- warning face ! (setq face 'font-lock-warning-face)) ! ((eq face-key ?p) ! ;; %fp -- server-prefix face ! (setq face 'rcirc-server-prefix)) ! ((eq face-key ?s) ! ;; %fs -- warning face ! (setq face 'rcirc-server)) ! ((eq face-key ?-) ! ;; %fs -- warning face ! (setq face nil)) ! ((and (eq face-key ?\[) ! (string-match "^\\([^]]*\\)[]]" chunk) ! (facep (match-string 1 chunk))) ! ;; %f[...] -- named face ! (setq face (intern (match-string 1 chunk))) ! (setq chunk (substring chunk (match-end 0))))) ! ""))) ! (setq result (concat result repl (rcirc-facify chunk face)))) ! result)) (defun rcirc-target-buffer (process sender response target text) "Return a buffer to print the server response." --- 1162,1228 ---- :value-type string) :group 'rcirc) + (defcustom rcirc-omit-responses + '("JOIN" "PART" "QUIT") + "Responses which will be hidden when `rcirc-omit-mode' is enabled." + :type '(repeat string) + :group 'rcirc) + (defun rcirc-format-response-string (process sender response target text) "Return a nicely-formatted response string, incorporating TEXT \(and perhaps other arguments). The specific formatting used is found by looking up RESPONSE in `rcirc-response-formats'." ! (with-temp-buffer ! (insert (or (cdr (assoc response rcirc-response-formats)) ! (cdr (assq t rcirc-response-formats)))) ! (goto-char (point-min)) ! (let ((start (point-min)) ! (sender (if (or (not sender) ! (string= (rcirc-server-name process) sender)) ! "" ! sender)) ! face) ! (while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t) ! (rcirc-add-face start (match-beginning 0) face) ! (setq start (match-beginning 0)) ! (replace-match ! (case (aref (match-string 1) 0) ! (?f (setq face ! (case (string-to-char (match-string 3)) ! (?w 'font-lock-warning-face) ! (?p 'rcirc-server-prefix) ! (?s 'rcirc-server) ! (t nil))) ! "") ! (?n sender) ! (?N (let ((my-nick (rcirc-nick process))) ! (save-match-data ! (with-syntax-table rcirc-nick-syntax-table ! (rcirc-facify sender ! (cond ((string= sender my-nick) ! 'rcirc-my-nick) ! ((and rcirc-bright-nicks ! (string-match ! (regexp-opt rcirc-bright-nicks ! 'words) ! sender)) ! 'rcirc-bright-nick) ! ((and rcirc-dim-nicks ! (string-match ! (regexp-opt rcirc-dim-nicks ! 'words) ! sender)) ! 'rcirc-dim-nick) ! (t ! 'rcirc-other-nick))))))) ! (?m (propertize text 'rcirc-text text)) ! (?r response) ! (?t (or target "")) ! (t (concat "UNKNOWN CODE:" (match-string 0)))) ! t t nil 0) ! (rcirc-add-face (match-beginning 0) (match-end 0) face)) ! (rcirc-add-face start (match-beginning 0) face)) ! (buffer-substring (point-min) (point-max)))) (defun rcirc-target-buffer (process sender response target text) "Return a buffer to print the server response." *************** *** 1177,1183 **** (rcirc-any-buffer process)) ((not (rcirc-channel-p target)) ;; message from another user ! (if (string= response "PRIVMSG") (rcirc-get-buffer-create process (if (string= sender rcirc-nick) target sender)) --- 1232,1239 ---- (rcirc-any-buffer process)) ((not (rcirc-channel-p target)) ;; message from another user ! (if (or (string= response "PRIVMSG") ! (string= response "ACTION")) (rcirc-get-buffer-create process (if (string= sender rcirc-nick) target sender)) *************** *** 1190,1195 **** --- 1246,1262 ---- (defvar rcirc-last-sender nil) (make-variable-buffer-local 'rcirc-last-sender) + (defcustom rcirc-log-directory "~/.emacs.d/rcirc-log" + "Directory to keep IRC logfiles." + :type 'directory + :group 'rcirc) + + (defcustom rcirc-log-flag nil + "Non-nil means log IRC activity to disk. + Logfiles are kept in `rcirc-log-directory'." + :type 'boolean + :group 'rcirc) + (defun rcirc-print (process sender response target text &optional activity) "Print TEXT in the buffer associated with TARGET. Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, *************** *** 1212,1218 **** (setq text (decode-coding-string text rcirc-decode-coding-system)) ;; mark the line with overlay arrow (unless (or (marker-position overlay-arrow-position) ! (get-buffer-window (current-buffer))) (set-marker overlay-arrow-position (marker-position rcirc-prompt-start-marker)))) --- 1279,1286 ---- (setq text (decode-coding-string text rcirc-decode-coding-system)) ;; mark the line with overlay arrow (unless (or (marker-position overlay-arrow-position) ! (get-buffer-window (current-buffer)) ! (member response rcirc-omit-responses)) (set-marker overlay-arrow-position (marker-position rcirc-prompt-start-marker)))) *************** *** 1222,1265 **** (set-marker-insertion-type rcirc-prompt-start-marker t) (set-marker-insertion-type rcirc-prompt-end-marker t) ! (let ((fmted-text ! (rcirc-format-response-string process sender response nil ! text))) ! ! (insert fmted-text (propertize "\n" 'hard t)) ! (set-marker-insertion-type rcirc-prompt-start-marker nil) ! (set-marker-insertion-type rcirc-prompt-end-marker nil) ! ! (let ((text-start (make-marker))) ! (set-marker text-start ! (or (next-single-property-change fill-start ! 'rcirc-text) ! rcirc-prompt-end-marker)) ! ;; squeeze spaces out of text before rcirc-text ! (fill-region fill-start (1- text-start)) ! ! ;; fill the text we just inserted, maybe ! (when (and rcirc-fill-flag ! (not (string= response "372"))) ;/motd ! (let ((fill-prefix ! (or rcirc-fill-prefix ! (make-string (- text-start fill-start) ?\s))) ! (fill-column (cond ((eq rcirc-fill-column 'frame-width) ! (1- (frame-width))) ! ((eq rcirc-fill-column 'window-width) ! (1- (window-width))) ! (rcirc-fill-column ! rcirc-fill-column) ! (t fill-column)))) ! (fill-region fill-start rcirc-prompt-start-marker 'left t))))) ! ! ;; set inserted text to be read-only ! (when rcirc-read-only-flag ! (put-text-property rcirc-prompt-start-marker fill-start 'read-only t) ! (let ((inhibit-read-only t)) ! (put-text-property rcirc-prompt-start-marker fill-start ! 'front-sticky t) ! (put-text-property (1- (point)) (point) 'rear-nonsticky t))) ;; truncate buffer if it is very long (save-excursion --- 1290,1329 ---- (set-marker-insertion-type rcirc-prompt-start-marker t) (set-marker-insertion-type rcirc-prompt-end-marker t) ! (let ((start (point))) ! (insert (rcirc-format-response-string process sender response nil ! text) ! (propertize "\n" 'hard t)) ! ! ;; squeeze spaces out of text before rcirc-text ! (fill-region fill-start ! (1- (or (next-single-property-change fill-start ! 'rcirc-text) ! rcirc-prompt-end-marker))) ! ! ;; run markup functions ! (save-excursion ! (save-restriction ! (narrow-to-region start rcirc-prompt-start-marker) ! (goto-char (or (next-single-property-change start 'rcirc-text) ! (point))) ! (when (rcirc-buffer-process) ! (save-excursion (rcirc-markup-timestamp sender response)) ! (dolist (fn rcirc-markup-text-functions) ! (save-excursion (funcall fn sender response))) ! (save-excursion (rcirc-markup-fill sender response))) ! ! (when rcirc-read-only-flag ! (add-text-properties (point-min) (point-max) ! '(read-only t front-sticky t)))) ! ;; make text omittable ! (when (and (member response rcirc-omit-responses) ! (> start (point-min))) ! (put-text-property (1- start) (1- rcirc-prompt-start-marker) ! 'invisible 'rcirc-omit)))) ! ! (set-marker-insertion-type rcirc-prompt-start-marker nil) ! (set-marker-insertion-type rcirc-prompt-end-marker nil) ;; truncate buffer if it is very long (save-excursion *************** *** 1275,1301 **** (window-buffer w)) (>= (window-point w) rcirc-prompt-end-marker)) ! (set-window-point w (point-max)))) nil t) ;; restore the point (goto-char (if moving rcirc-prompt-end-marker old-point)) ! ;; keep window on bottom line if it was already there (when rcirc-scroll-show-maximum-output (walk-windows (lambda (w) (when (eq (window-buffer w) (current-buffer)) (with-current-buffer (window-buffer w) (when (eq major-mode 'rcirc-mode) (with-selected-window w ! (when (<= (- (window-height) ! (count-screen-lines ! (window-point) ! (window-start)) 1) 0) (recenter -1))))))) ! nil t)) ;; flush undo (can we do something smarter here?) (buffer-disable-undo) --- 1339,1364 ---- (window-buffer w)) (>= (window-point w) rcirc-prompt-end-marker)) ! (set-window-point w (point-max)))) nil t) ;; restore the point (goto-char (if moving rcirc-prompt-end-marker old-point)) ! ;; keep window on bottom line if it was already there (when rcirc-scroll-show-maximum-output (walk-windows (lambda (w) (when (eq (window-buffer w) (current-buffer)) (with-current-buffer (window-buffer w) (when (eq major-mode 'rcirc-mode) (with-selected-window w ! (when (<= (- (window-height) ! (count-screen-lines (window-point) ! (window-start)) 1) 0) (recenter -1))))))) ! nil t)) ;; flush undo (can we do something smarter here?) (buffer-disable-undo) *************** *** 1305,1326 **** (when (and activity (not rcirc-ignore-buffer-activity-flag) (not (and rcirc-dim-nicks sender ! (string-match (regexp-opt rcirc-dim-nicks) sender)))) (rcirc-record-activity (current-buffer) (when (not (rcirc-channel-p rcirc-target)) 'nick))) (sit-for 0) ; displayed text before hook (run-hook-with-args 'rcirc-print-hooks process sender response target text))))) ! (defun rcirc-startup-channels (server) ! "Return the list of startup channels for SERVER." ! (let (channels) ! (dolist (i rcirc-startup-channels-alist) ! (if (string-match (car i) server) ! (setq channels (append channels (cdr i))))) ! channels)) (defun rcirc-join-channels (process channels) "Join CHANNELS." --- 1368,1412 ---- (when (and activity (not rcirc-ignore-buffer-activity-flag) (not (and rcirc-dim-nicks sender ! (string-match (regexp-opt rcirc-dim-nicks) sender) ! (rcirc-channel-p target)))) (rcirc-record-activity (current-buffer) (when (not (rcirc-channel-p rcirc-target)) 'nick))) + (when rcirc-log-flag + (rcirc-log process sender response target text)) + (sit-for 0) ; displayed text before hook (run-hook-with-args 'rcirc-print-hooks process sender response target text))))) ! (defun rcirc-log (process sender response target text) ! "Record line in `rcirc-log', to be later written to disk." ! (let* ((filename (rcirc-generate-new-buffer-name process target)) ! (cell (assoc-string filename rcirc-log-alist)) ! (line (concat (format-time-string rcirc-time-format) ! (substring-no-properties ! (rcirc-format-response-string process sender ! response target text)) ! "\n"))) ! (if cell ! (setcdr cell (concat (cdr cell) line)) ! (setq rcirc-log-alist ! (cons (cons filename line) rcirc-log-alist))))) ! ! (defun rcirc-log-write () ! "Flush `rcirc-log-alist' data to disk. ! ! Log data is written to `rcirc-log-directory'." ! (make-directory rcirc-log-directory t) ! (dolist (cell rcirc-log-alist) ! (with-temp-buffer ! (insert (cdr cell)) ! (write-region (point-min) (point-max) ! (concat rcirc-log-directory "/" (car cell)) ! t 'quiet))) ! (setq rcirc-log-alist nil)) (defun rcirc-join-channels (process channels) "Join CHANNELS." *************** *** 1437,1442 **** --- 1523,1531 ---- (or (assq 'rcirc-low-priority-flag minor-mode-alist) (setq minor-mode-alist (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist))) + (or (assq 'rcirc-omit-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(rcirc-omit-mode " Omit") minor-mode-alist))) (defun rcirc-toggle-ignore-buffer-activity () "Toggle the value of `rcirc-ignore-buffer-activity-flag'." *************** *** 1458,1505 **** "Activity in this buffer is normal priority")) (force-mode-line-update)) ! (defvar rcirc-switch-to-buffer-function 'switch-to-buffer ! "Function to use when switching buffers. ! Possible values are `switch-to-buffer', `pop-to-buffer', and ! `display-buffer'.") (defun rcirc-switch-to-server-buffer () "Switch to the server buffer associated with current channel buffer." (interactive) ! (funcall rcirc-switch-to-buffer-function rcirc-server-buffer)) (defun rcirc-jump-to-first-unread-line () "Move the point to the first unread line in this buffer." (interactive) ! (when (marker-position overlay-arrow-position) ! (goto-char overlay-arrow-position))) ! ! (defvar rcirc-last-non-irc-buffer nil ! "The buffer to switch to when there is no more activity.") (defun rcirc-next-active-buffer (arg) ! "Go to the next rcirc buffer with activity. ! With prefix ARG, go to the next low priority buffer with activity. ! The function given by `rcirc-switch-to-buffer-function' is used to ! show the buffer." (interactive "P") (let* ((pair (rcirc-split-activity rcirc-activity)) (lopri (car pair)) (hipri (cdr pair))) (if (or (and (not arg) hipri) (and arg lopri)) ! (progn ! (unless (eq major-mode 'rcirc-mode) ! (setq rcirc-last-non-irc-buffer (current-buffer))) ! (funcall rcirc-switch-to-buffer-function ! (car (if arg lopri hipri)))) (if (eq major-mode 'rcirc-mode) ! (if (not (and rcirc-last-non-irc-buffer ! (buffer-live-p rcirc-last-non-irc-buffer))) ! (message "No IRC activity. Start something.") ! (message "No more IRC activity. Go back to work.") ! (funcall rcirc-switch-to-buffer-function rcirc-last-non-irc-buffer) ! (setq rcirc-last-non-irc-buffer nil)) (message (concat "No IRC activity." (when lopri --- 1547,1605 ---- "Activity in this buffer is normal priority")) (force-mode-line-update)) ! (defun rcirc-omit-mode () ! "Toggle the Rcirc-Omit mode. ! If enabled, \"uninteresting\" lines are not shown. ! Uninteresting lines are those whose responses are listed in ! `rcirc-omit-responses'." ! (interactive) ! (setq rcirc-omit-mode (not rcirc-omit-mode)) ! (let ((line (1- (count-screen-lines (point) (window-start))))) ! (if rcirc-omit-mode ! (progn ! (add-to-invisibility-spec 'rcirc-omit) ! (message "Rcirc-Omit mode enabled")) ! (remove-from-invisibility-spec 'rcirc-omit) ! (message "Rcirc-Omit mode disabled")) ! (recenter line)) ! (force-mode-line-update)) (defun rcirc-switch-to-server-buffer () "Switch to the server buffer associated with current channel buffer." (interactive) ! (switch-to-buffer rcirc-server-buffer)) (defun rcirc-jump-to-first-unread-line () "Move the point to the first unread line in this buffer." (interactive) ! (if (marker-position overlay-arrow-position) ! (goto-char overlay-arrow-position) ! (message "No unread messages"))) ! ! (defun rcirc-non-irc-buffer () ! (let ((buflist (buffer-list)) ! buffer) ! (while (and buflist (not buffer)) ! (with-current-buffer (car buflist) ! (unless (or (eq major-mode 'rcirc-mode) ! (= ?\s (aref (buffer-name) 0)) ; internal buffers ! (get-buffer-window (current-buffer))) ! (setq buffer (current-buffer)))) ! (setq buflist (cdr buflist))) ! buffer)) (defun rcirc-next-active-buffer (arg) ! "Switch to the next rcirc buffer with activity. ! With prefix ARG, go to the next low priority buffer with activity." (interactive "P") (let* ((pair (rcirc-split-activity rcirc-activity)) (lopri (car pair)) (hipri (cdr pair))) (if (or (and (not arg) hipri) (and arg lopri)) ! (switch-to-buffer (car (if arg lopri hipri)) t) (if (eq major-mode 'rcirc-mode) ! (switch-to-buffer (rcirc-non-irc-buffer)) (message (concat "No IRC activity." (when lopri *************** *** 1518,1532 **** (defun rcirc-record-activity (buffer &optional type) "Record BUFFER activity with TYPE." (with-current-buffer buffer ! (when (not (get-buffer-window (current-buffer) t)) ! (setq rcirc-activity ! (sort (add-to-list 'rcirc-activity (current-buffer)) ! (lambda (b1 b2) ! (let ((t1 (with-current-buffer b1 rcirc-last-post-time)) ! (t2 (with-current-buffer b2 rcirc-last-post-time))) ! (time-less-p t2 t1))))) ! (pushnew type rcirc-activity-types) ! (rcirc-update-activity-string))) (run-hook-with-args 'rcirc-activity-hooks buffer)) (defun rcirc-clear-activity (buffer) --- 1618,1636 ---- (defun rcirc-record-activity (buffer &optional type) "Record BUFFER activity with TYPE." (with-current-buffer buffer ! (let ((old-activity rcirc-activity) ! (old-types rcirc-activity-types)) ! (when (not (get-buffer-window (current-buffer) t)) ! (setq rcirc-activity ! (sort (add-to-list 'rcirc-activity (current-buffer)) ! (lambda (b1 b2) ! (let ((t1 (with-current-buffer b1 rcirc-last-post-time)) ! (t2 (with-current-buffer b2 rcirc-last-post-time))) ! (time-less-p t2 t1))))) ! (pushnew type rcirc-activity-types) ! (unless (and (equal rcirc-activity old-activity) ! (member type old-types)) ! (rcirc-update-activity-string))))) (run-hook-with-args 'rcirc-activity-hooks buffer)) (defun rcirc-clear-activity (buffer) *************** *** 1535,1540 **** --- 1639,1650 ---- (with-current-buffer buffer (setq rcirc-activity-types nil))) + (defun rcirc-clear-unread (buffer) + "Erase the last read message arrow from BUFFER." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (set-marker overlay-arrow-position nil)))) + (defun rcirc-split-activity (activity) "Return a cons cell with ACTIVITY split into (lopri . hipri)." (let (lopri hipri) *************** *** 1546,1551 **** --- 1656,1664 ---- (add-to-list 'hipri buf t)))) (cons lopri hipri))) + (defvar rcirc-update-activity-string-hook nil + "Hook run whenever the activity string is updated.") + ;; TODO: add mouse properties (defun rcirc-update-activity-string () "Update mode-line string." *************** *** 1554,1572 **** (hipri (cdr pair))) (setq rcirc-activity-string (cond ((or hipri lopri) ! (concat "-" ! (and hipri "[") (rcirc-activity-string hipri) (and hipri lopri ",") (and lopri (concat "(" (rcirc-activity-string lopri) ")")) ! (and hipri "]") ! "-")) ((not (null (rcirc-process-list))) ! "-[]-") ! (t ""))))) (defun rcirc-activity-string (buffers) (mapconcat (lambda (b) --- 1667,1684 ---- (hipri (cdr pair))) (setq rcirc-activity-string (cond ((or hipri lopri) ! (concat (and hipri "[") (rcirc-activity-string hipri) (and hipri lopri ",") (and lopri (concat "(" (rcirc-activity-string lopri) ")")) ! (and hipri "]"))) ((not (null (rcirc-process-list))) ! "[]") ! (t "[]"))) ! (run-hooks 'rcirc-update-activity-string-hook))) (defun rcirc-activity-string (buffers) (mapconcat (lambda (b) *************** *** 1586,1618 **** (with-current-buffer buffer (or rcirc-short-buffer-name (buffer-name)))) ! (defvar rcirc-current-buffer nil) ! (defun rcirc-window-configuration-change () ! "Go through visible windows and remove buffers from activity list. ! Also, clear the overlay arrow if the current buffer is now hidden." ! (let ((current-now-hidden t)) (walk-windows (lambda (w) ! (let ((buf (window-buffer w))) ! (with-current-buffer buf ! (when (eq major-mode 'rcirc-mode) ! (rcirc-clear-activity buf))) ! (when (eq buf rcirc-current-buffer) ! (setq current-now-hidden nil))))) ! ;; add overlay arrow if the buffer isn't displayed ! (when (and current-now-hidden ! rcirc-current-buffer ! (buffer-live-p rcirc-current-buffer)) ! (with-current-buffer rcirc-current-buffer ! (when (and (eq major-mode 'rcirc-mode) ! (marker-position overlay-arrow-position)) ! (set-marker overlay-arrow-position nil))))) ! ! ;; remove any killed buffers from list ! (setq rcirc-activity ! (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf)) ! rcirc-activity))) ! (rcirc-update-activity-string) ! (setq rcirc-current-buffer (current-buffer))) ;;; buffer name abbreviation --- 1698,1744 ---- (with-current-buffer buffer (or rcirc-short-buffer-name (buffer-name)))) ! (defun rcirc-visible-buffers () ! "Return a list of the visible buffers that are in rcirc-mode." ! (let (acc) (walk-windows (lambda (w) ! (with-current-buffer (window-buffer w) ! (when (eq major-mode 'rcirc-mode) ! (push (current-buffer) acc))))) ! acc)) ! ! (defvar rcirc-visible-buffers nil) ! (defun rcirc-window-configuration-change () ! (unless (minibuffer-window-active-p (minibuffer-window)) ! ;; delay this until command has finished to make sure window is ! ;; actually visible before clearing activity ! (add-hook 'post-command-hook 'rcirc-window-configuration-change-1))) ! ! (defun rcirc-window-configuration-change-1 () ! ;; clear activity and overlay arrows ! (let* ((old-activity rcirc-activity) ! (hidden-buffers rcirc-visible-buffers)) ! ! (setq rcirc-visible-buffers (rcirc-visible-buffers)) ! ! (dolist (vbuf rcirc-visible-buffers) ! (setq hidden-buffers (delq vbuf hidden-buffers)) ! ;; clear activity for all visible buffers ! (rcirc-clear-activity vbuf)) ! ! ;; clear unread arrow from recently hidden buffers ! (dolist (hbuf hidden-buffers) ! (rcirc-clear-unread hbuf)) ! ! ;; remove any killed buffers from list ! (setq rcirc-activity ! (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf)) ! rcirc-activity))) ! ;; update the mode-line string ! (unless (equal old-activity rcirc-activity) ! (rcirc-update-activity-string))) ! ! (remove-hook 'post-command-hook 'rcirc-window-configuration-change-1)) ;;; buffer name abbreviation *************** *** 1722,1729 **** (car (split-string channel))))) (rcirc-send-string process (concat "JOIN " channel)) (when (not (eq (selected-window) (minibuffer-window))) ! (funcall rcirc-switch-to-buffer-function buffer)))) (defun-rcirc-command part (channel) "Part CHANNEL." (interactive "sPart channel: ") --- 1848,1856 ---- (car (split-string channel))))) (rcirc-send-string process (concat "JOIN " channel)) (when (not (eq (selected-window) (minibuffer-window))) ! (switch-to-buffer buffer)))) + ;; TODO: /part #channel reason, or consider removing #channel altogether (defun-rcirc-command part (channel) "Part CHANNEL." (interactive "sPart channel: ") *************** *** 1902,1908 **** word-boundary)) (optional (and "/" ! (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,{}[]()")) (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]()"))))) "Regexp matching URLs. Set to nil to disable URL features in rcirc.") --- 2029,2035 ---- word-boundary)) (optional (and "/" ! (1+ (char "-a-zA-Z0-9_='!?#$\@~`%&*+|\\/:;.,{}[]()")) (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]()"))))) "Regexp matching URLs. Set to nil to disable URL features in rcirc.") *************** *** 1932,1969 **** (defvar rcirc-markup-text-functions ! '(rcirc-markup-body-text ! rcirc-markup-attributes rcirc-markup-my-nick rcirc-markup-urls rcirc-markup-keywords ! rcirc-markup-bright-nicks) "List of functions used to manipulate text before it is printed. ! Each function takes three arguments, PROCESS, SENDER, RESPONSE ! and CHANNEL-BUFFER. The current buffer is temporary buffer that ! contains the text to manipulate. Each function works on the text ! in this buffer.") ! ! (defun rcirc-markup-text (process sender response text) ! "Return TEXT with properties added based on various patterns." ! (let ((channel-buffer (current-buffer))) ! (with-temp-buffer ! (insert text) ! (goto-char (point-min)) ! (dolist (fn rcirc-markup-text-functions) ! (save-excursion ! (funcall fn process sender response channel-buffer))) ! (buffer-substring (point-min) (point-max))))) ! ! (defun rcirc-markup-body-text (process sender response channel-buffer) ! ;; We add the text property `rcirc-text' to identify this as the ! ;; body text. ! (add-text-properties (point-min) (point-max) ! (list 'rcirc-text (buffer-substring-no-properties ! (point-min) (point-max))))) ! (defun rcirc-markup-attributes (process sender response channel-buffer) (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) (rcirc-add-face (match-beginning 0) (match-end 0) (case (char-after (match-beginning 1)) --- 2059,2083 ---- (defvar rcirc-markup-text-functions ! '(rcirc-markup-attributes rcirc-markup-my-nick rcirc-markup-urls rcirc-markup-keywords ! rcirc-markup-bright-nicks ! rcirc-markup-fill) ! "List of functions used to manipulate text before it is printed. ! Each function takes two arguments, SENDER, RESPONSE. The buffer ! is narrowed with the text to be printed and the point is at the ! beginning of the `rcirc-text' propertized text.") ! ! (defun rcirc-markup-timestamp (sender response) ! (goto-char (point-min)) ! (insert (rcirc-facify (format-time-string rcirc-time-format) ! 'rcirc-timestamp))) ! (defun rcirc-markup-attributes (sender response) (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) (rcirc-add-face (match-beginning 0) (match-end 0) (case (char-after (match-beginning 1)) *************** *** 1979,1997 **** (while (re-search-forward "\C-o+" nil t) (delete-region (match-beginning 0) (match-end 0)))) ! (defun rcirc-markup-my-nick (process sender response channel-buffer) (with-syntax-table rcirc-nick-syntax-table ! (while (re-search-forward (concat "\\b" ! (regexp-quote (rcirc-nick process)) "\\b") nil t) (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-nick-in-message) (when (string= response "PRIVMSG") ! (rcirc-add-face (point-min) (point-max) 'rcirc-nick-in-message-full-line) ! (rcirc-record-activity channel-buffer 'nick))))) ! (defun rcirc-markup-urls (process sender response channel-buffer) (while (re-search-forward rcirc-url-regexp nil t) (let ((start (match-beginning 0)) (end (match-end 0))) --- 2093,2113 ---- (while (re-search-forward "\C-o+" nil t) (delete-region (match-beginning 0) (match-end 0)))) ! (defun rcirc-markup-my-nick (sender response) (with-syntax-table rcirc-nick-syntax-table ! (while (re-search-forward (concat "\\b" ! (regexp-quote (rcirc-nick ! (rcirc-buffer-process))) "\\b") nil t) (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-nick-in-message) (when (string= response "PRIVMSG") ! (rcirc-add-face (point-min) (point-max) ! 'rcirc-nick-in-message-full-line) ! (rcirc-record-activity (current-buffer) 'nick))))) ! (defun rcirc-markup-urls (sender response) (while (re-search-forward rcirc-url-regexp nil t) (let ((start (match-beginning 0)) (end (match-end 0))) *************** *** 1999,2028 **** (add-text-properties start end (list 'mouse-face 'highlight 'keymap rcirc-browse-url-map)) ;; record the url ! (let ((url (buffer-substring-no-properties start end))) ! (with-current-buffer channel-buffer ! (push url rcirc-urls)))))) ! ! (defun rcirc-markup-keywords (process sender response channel-buffer) ! (let* ((target (with-current-buffer channel-buffer (or rcirc-target ""))) ! (keywords (delq nil (mapcar (lambda (keyword) ! (when (not (string-match keyword target)) ! keyword)) ! rcirc-keywords)))) ! (when keywords ! (while (re-search-forward (regexp-opt keywords 'words) nil t) ! (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword) ! (when (and (string= response "PRIVMSG") ! (not (string= sender (rcirc-nick process)))) ! (rcirc-record-activity channel-buffer 'keyword)))))) ! (defun rcirc-markup-bright-nicks (process sender response channel-buffer) (when (and rcirc-bright-nicks (string= response "NAMES")) (with-syntax-table rcirc-nick-syntax-table (while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t) (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-bright-nick))))) ;;; handlers ;; these are called with the server PROCESS, the SENDER, which is a --- 2115,2155 ---- (add-text-properties start end (list 'mouse-face 'highlight 'keymap rcirc-browse-url-map)) ;; record the url ! (push (buffer-substring-no-properties start end) rcirc-urls)))) ! (defun rcirc-markup-keywords (sender response) ! (when (and (string= response "PRIVMSG") ! (not (string= sender (rcirc-nick (rcirc-buffer-process))))) ! (let* ((target (or rcirc-target "")) ! (keywords (delq nil (mapcar (lambda (keyword) ! (when (not (string-match keyword ! target)) ! keyword)) ! rcirc-keywords)))) ! (when keywords ! (while (re-search-forward (regexp-opt keywords 'words) nil t) ! (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword) ! (rcirc-record-activity (current-buffer) 'keyword)))))) ! ! (defun rcirc-markup-bright-nicks (sender response) (when (and rcirc-bright-nicks (string= response "NAMES")) (with-syntax-table rcirc-nick-syntax-table (while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t) (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-bright-nick))))) + + (defun rcirc-markup-fill (sender response) + (when (not (string= response "372")) ; /motd + (let ((fill-prefix + (or rcirc-fill-prefix + (make-string (- (point) (line-beginning-position)) ?\s))) + (fill-column (cond ((eq rcirc-fill-column 'frame-width) + (1- (frame-width))) + (rcirc-fill-column + rcirc-fill-column) + (t fill-column)))) + (fill-region (point) (point-max) nil t)))) ;;; handlers ;; these are called with the server PROCESS, the SENDER, which is a *************** *** 2099,2106 **** ;; if the buffer is still around, make it inactive (let ((buffer (rcirc-get-buffer process channel))) (when buffer ! (with-current-buffer buffer ! (setq rcirc-target nil)))))) (defun rcirc-handler-PART (process sender args text) (let* ((channel (car args)) --- 2226,2232 ---- ;; if the buffer is still around, make it inactive (let ((buffer (rcirc-get-buffer process channel))) (when buffer ! (rcirc-disconnect-buffer buffer))))) (defun rcirc-handler-PART (process sender args text) (let* ((channel (car args)) *************** *** 2169,2175 **** (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) (defun rcirc-handler-PING (process sender args text) ! (rcirc-send-string process (concat "PONG " (car args)))) (defun rcirc-handler-PONG (process sender args text) ;; do nothing --- 2295,2301 ---- (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) (defun rcirc-handler-PING (process sender args text) ! (rcirc-send-string process (concat "PONG :" (car args)))) (defun rcirc-handler-PONG (process sender args text) ;; do nothing *************** *** 2289,2295 **** process (concat "PRIVMSG chanserv :identify " ! (cadr args) " " (car args)))) ((equal method 'bitlbee) (rcirc-send-string process --- 2415,2421 ---- process (concat "PRIVMSG chanserv :identify " ! (car args) " " (cadr args)))) ((equal method 'bitlbee) (rcirc-send-string process *************** *** 2314,2320 **** (format "%s sent unsupported ctcp: %s" sender text) t) (funcall handler process target sender args) ! (if (not (string= request "ACTION")) (rcirc-print process sender "CTCP" target (format "%s" text) t)))))) --- 2440,2447 ---- (format "%s sent unsupported ctcp: %s" sender text) t) (funcall handler process target sender args) ! (unless (or (string= request "ACTION") ! (string= request "KEEPALIVE")) (rcirc-print process sender "CTCP" target (format "%s" text) t))))))