Mercurial > emacs

changeset 68079:61e9ea461d3c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(rcirc-ignore-list): New option. (rcirc-ignore-list-automatic): New variable. (rcirc-print): Take rcirc-ignore-list into account. (rcirc-cmd-ignore): New command. (rcirc-ignore-update-automatic): New function. (rcirc-handler-PART, rcirc-handler-QUIT): Use it to maintain the list if ignored nicks. (rcirc-handler-NICK): Ditto, and also ignore the new nick.
author Alex Schroeder <alex@gnu.org>
date Sat, 07 Jan 2006 02:50:27 +0000
parents 4d3683425793
children f9bd25bc28cc
files lisp/net/rcirc.el
diffstat 1 files changed, 164 insertions(+), 112 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/net/rcirc.el	Sat Jan 07 02:29:14 2006 +0000
+++ b/lisp/net/rcirc.el	Sat Jan 07 02:50:27 2006 +0000
@@ -181,6 +181,18 @@
   :initialize 'custom-initialize-default
   :group 'rcirc)
 
+(defcustom rcirc-ignore-list ()
+  "List of ignored nicks.
+Use /ignore to list them, use /ignore NICK to add or remove a nick."
+  :type '(repeat string)
+  :group 'rcirc)
+
+(defvar rcirc-ignore-list-automatic ()
+  "List of ignored nicks added to `rcirc-ignore-list' because of renaming.
+When an ignored person renames, their nick is added to both lists.
+Nicks will be removed from the automatic list on follow-up renamings or
+parts.")
+
 (defcustom rcirc-print-hooks nil
   "Hook run after text is printed.
 Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
@@ -192,6 +204,14 @@
 
 (defvar rcirc-nick-table nil)
 
+(defvar rcirc-nick-syntax-table
+  (let ((table (make-syntax-table text-mode-syntax-table)))
+    (mapc (lambda (c) (modify-syntax-entry c "w" table))
+          "[]\\`_^{|}-")
+    (modify-syntax-entry ?' "_" table)
+    table)
+  "Syntax table which includes all nick characters as word constituents.")
+
 ;; each process has an alist of (target . buffer) pairs
 (defvar rcirc-buffer-alist nil)
 
@@ -906,120 +926,124 @@
   "Print TEXT in the buffer associated with TARGET.
 Format based on SENDER and RESPONSE.  If ACTIVITY is non-nil,
 record activity."
-  (let* ((buffer (cond ((bufferp target)
-                        target)
-                       ((not target)
-			(rcirc-get-any-buffer process))
-		       ((not (rcirc-channel-p target))
-			(rcirc-get-buffer-create process
-						 (rcirc-user-nick sender)))
-                       ((or (rcirc-get-buffer process target)
-			    (rcirc-get-any-buffer process)))))
-         (inhibit-read-only t))
-    (with-current-buffer buffer
-      (let ((moving (= (point) rcirc-prompt-end-marker))
-            (old-point (point-marker))
-            (fill-start (marker-position rcirc-prompt-start-marker)))
+  (unless (or (member (rcirc-user-nick sender) rcirc-ignore-list)
+	      (member (with-syntax-table rcirc-nick-syntax-table
+			(when (string-match "^\\([^/]\\w*\\)[:,]" text)
+			  (match-string 1 text))) rcirc-ignore-list))
+    (let* ((buffer (cond ((bufferp target)
+			  target)
+			 ((not target)
+			  (rcirc-get-any-buffer process))
+			 ((not (rcirc-channel-p target))
+			  (rcirc-get-buffer-create process
+						   (rcirc-user-nick sender)))
+			 ((or (rcirc-get-buffer process target)
+			      (rcirc-get-any-buffer process)))))
+	   (inhibit-read-only t))
+      (with-current-buffer buffer
+	(let ((moving (= (point) rcirc-prompt-end-marker))
+	      (old-point (point-marker))
+	      (fill-start (marker-position rcirc-prompt-start-marker)))
 
-        (unless (string= sender (rcirc-nick process))
-	  ;; only decode text from other senders, not ours
-	  (setq text (decode-coding-string (or text "")
-					   buffer-file-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))))
+	  (unless (string= sender (rcirc-nick process))
+	    ;; only decode text from other senders, not ours
+	    (setq text (decode-coding-string (or text "")
+					     buffer-file-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))))
 
-        ;; temporarily set the marker insertion-type because
-        ;; insert-before-markers results in hidden text in new buffers
-        (goto-char rcirc-prompt-start-marker)
-        (set-marker-insertion-type rcirc-prompt-start-marker t)
-        (set-marker-insertion-type rcirc-prompt-end-marker t)
-        (insert
-	 (rcirc-format-response-string process sender response target text)
-	 (propertize "\n" 'hard t))
-        (set-marker-insertion-type rcirc-prompt-start-marker nil)
-        (set-marker-insertion-type rcirc-prompt-end-marker nil)
+	  ;; temporarily set the marker insertion-type because
+	  ;; insert-before-markers results in hidden text in new buffers
+	  (goto-char rcirc-prompt-start-marker)
+	  (set-marker-insertion-type rcirc-prompt-start-marker t)
+	  (set-marker-insertion-type rcirc-prompt-end-marker t)
+	  (insert
+	   (rcirc-format-response-string process sender response target text)
+	   (propertize "\n" 'hard t))
+	  (set-marker-insertion-type rcirc-prompt-start-marker nil)
+	  (set-marker-insertion-type rcirc-prompt-end-marker nil)
 
-        ;; 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
-                      (+ (if rcirc-time-format
-                             (length (format-time-string
-                                      rcirc-time-format))
-                           0)
-                         (cond ((or (string= response "PRIVMSG")
-				    (string= response "NOTICE"))
-				(+ (length (rcirc-user-nick sender))
-				   2))	; <>
-			       ((string= response "ACTION")
-				(+ (length (rcirc-user-nick sender))
-				   1))		; [
-			       (t 3))		; ***
-                         1)
-                      ? )))
-                (fill-column (cond ((eq rcirc-fill-column 'frame-width)
-				    (1- (frame-width)))
-				   (rcirc-fill-column
-				    rcirc-fill-column)
-				   (t fill-column))))
-            (fill-region fill-start rcirc-prompt-start-marker 'left t)))
+	  ;; 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
+			(+ (if rcirc-time-format
+			       (length (format-time-string
+					rcirc-time-format))
+			     0)
+			   (cond ((or (string= response "PRIVMSG")
+				      (string= response "NOTICE"))
+				  (+ (length (rcirc-user-nick sender))
+				     2)) ; <>
+				 ((string= response "ACTION")
+				  (+ (length (rcirc-user-nick sender))
+				     1))	; [
+				 (t 3))		; ***
+			   1)
+			? )))
+		  (fill-column (cond ((eq rcirc-fill-column 'frame-width)
+				      (1- (frame-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)))
+	  ;; 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
-          (when (and rcirc-buffer-maximum-lines
-                     (> rcirc-buffer-maximum-lines 0)
-                     (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
-            (delete-region (point-min) (point))))
+	  ;; truncate buffer if it is very long
+	  (save-excursion
+	    (when (and rcirc-buffer-maximum-lines
+		       (> rcirc-buffer-maximum-lines 0)
+		       (= (forward-line (- rcirc-buffer-maximum-lines)) 0))
+	      (delete-region (point-min) (point))))
 
-        ;; set the window point for buffers show in windows
-        (walk-windows (lambda (w)
-                        (unless (eq (selected-window) w)
-                          (when (and (eq (current-buffer)
-					 (window-buffer w))
-                                     (>= (window-point w)
-					 rcirc-prompt-end-marker))
-                            (set-window-point w (point-max)))))
-                      nil t)
+	  ;; set the window point for buffers show in windows
+	  (walk-windows (lambda (w)
+			  (unless (eq (selected-window) w)
+			    (when (and (eq (current-buffer)
+					   (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))
+	  ;; restore the point
+	  (goto-char (if moving rcirc-prompt-end-marker old-point))
 
-        ;; flush undo (can we do something smarter here?)
-	(buffer-disable-undo)
-	(buffer-enable-undo))
+	  ;; flush undo (can we do something smarter here?)
+	  (buffer-disable-undo)
+	  (buffer-enable-undo))
 
-      ;; record modeline activity
-      (when activity
-        (let ((nick-match
-	       (string-match (concat "\\b"
-				     (regexp-quote (rcirc-nick process))
-				     "\\b")
-			     text)))
-          (when (or (not rcirc-ignore-buffer-activity-flag)
-                    ;; always notice when our nick is mentioned, even
-                    ;; if ignoring channel activity
-                    nick-match)
-            (rcirc-record-activity
-	     (current-buffer)
-	     (when (or nick-match (not (rcirc-channel-p rcirc-target)))
-	       'nick)))))
+	;; record modeline activity
+	(when activity
+	  (let ((nick-match
+		 (string-match (concat "\\b"
+				       (regexp-quote (rcirc-nick process))
+				       "\\b")
+			       text)))
+	    (when (or (not rcirc-ignore-buffer-activity-flag)
+		      ;; always notice when our nick is mentioned, even
+		      ;; if ignoring channel activity
+		      nick-match)
+	      (rcirc-record-activity
+	       (current-buffer)
+	       (when (or nick-match (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))))
+	(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."
@@ -1101,6 +1125,15 @@
        rcirc-nick-table)
       (mapcar (lambda (x) (car x))
               (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x))))))))
+
+(defun rcirc-ignore-update-automatic (nick)
+  "Remove NICK from  `rcirc-ignore-list'
+if NICK is also on  `rcirc-ignore-list-automatic'."
+  (when (member nick rcirc-ignore-list-automatic)
+      (setq rcirc-ignore-list-automatic
+	    (delete nick rcirc-ignore-list-automatic)
+	    rcirc-ignore-list
+	    (delete nick rcirc-ignore-list))))
 
 ;;; activity tracking
 (or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
@@ -1448,6 +1481,26 @@
 (defun rcirc-cmd-me (args &optional process target)
   (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a"
                                      target args)))
+
+(defun-rcirc-command ignore (nick)
+  "Manage the ignore list.
+Ignore NICK, unignore NICK if already ignored, or list ignored
+nicks when no NICK is given.  When listing ignored nicks, the
+ones added to the list automatically are marked with an asterix."
+  (interactive "sToggle ignoring of nick: ")
+  (if (string= "" nick)
+      (rcirc-print process (rcirc-nick process) "NOTICE" target 
+		   (mapconcat
+		    (lambda (nick)
+		      (concat nick
+			      (if (member nick rcirc-ignore-list-automatic)
+				  "*" "")))
+		    rcirc-ignore-list " "))
+    (if (member nick rcirc-ignore-list)
+	(setq rcirc-ignore-list (delete nick rcirc-ignore-list))
+      (setq rcirc-ignore-list (cons nick rcirc-ignore-list)))))
+
+
 
 (defun rcirc-message-leader (sender face)
   "Return a string with SENDER propertized with FACE."
@@ -1502,14 +1555,6 @@
       (funcall function (match-beginning 0) (match-end 0) string)))
   string)
 
-(defvar rcirc-nick-syntax-table
-  (let ((table (make-syntax-table text-mode-syntax-table)))
-    (mapc (lambda (c) (modify-syntax-entry c "w" table))
-          "[]\\`_^{|}-")
-    (modify-syntax-entry ?' "_" table)
-    table)
-  "Syntax table which includes all nick characters as word constituents.")
-
 (defun rcirc-mangle-text (process text)
   "Return TEXT with properties added based on various patterns."
   ;; ^B
@@ -1650,6 +1695,7 @@
 	  (setq rcirc-target nil))))))
 
 (defun rcirc-handler-PART (process sender args text)
+  (rcirc-ignore-update-automatic (rcirc-user-nick sender))
   (rcirc-handler-PART-or-KICK process "PART"
                               (car args) sender (rcirc-user-nick sender)
                               (cadr args)))
@@ -1659,6 +1705,7 @@
                               (caddr args)))
 
 (defun rcirc-handler-QUIT (process sender args text)
+  (rcirc-ignore-update-automatic (rcirc-user-nick sender))
   (let ((nick (rcirc-user-nick sender)))
     (mapc (lambda (channel)
             (rcirc-print process sender "QUIT" channel (apply 'concat args)))
@@ -1675,6 +1722,11 @@
   (let* ((old-nick (rcirc-user-nick sender))
          (new-nick (car args))
          (channels (rcirc-nick-channels process old-nick)))
+    ;; update list of ignored nicks
+    (rcirc-ignore-update-automatic old-nick)
+    (when (member old-nick rcirc-ignore-list)
+      (add-to-list 'rcirc-ignore-list new-nick)
+      (add-to-list 'rcirc-ignore-list-automatic new-nick))
     ;; print message to nick's channels
     (dolist (target channels)
       (rcirc-print process sender "NICK" target new-nick))