: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."
(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)
"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 (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)
-
- ;; 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)))
-
- ;; 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)
-
- ;; 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))
-
- ;; 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))))
+ (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))))
+
+ ;; 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)))
+
+ ;; 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))))
+
+ ;; 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))
+
+ ;; 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)))))
+
+ (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."
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))))
\f
;;; activity tracking
(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
(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)))))
+
+
\f
(defun rcirc-message-leader (sender face)
"Return a string with SENDER propertized with FACE."
(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
(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)))
(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)))
(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))
projects / emacs.git / commitdiff