changeset 85745:bece18fa22d7

Ryan Yeske <rcyeske at gmail.com> (rcirc-server-alist): Use coloned symbols for parameter names. (rcirc-recent-quit-alist): New function. (rcirc): Print a better message when there is only one connected server. (rcirc-complete-nick): Do not update the nick table here. (rcirc-mode-map): Add M-o. (rcirc-current-line): Add variable. (rcirc-mode): Setup variables for line based omit. (rcirc-edit-multiline): Strip text properties. (rcirc-omit-responses): Add NICK. (rcirc-omit-threshold): Add variable. (rcirc-last-quit-line, rcirc-last-line, rcirc-elapsed-lines): Add functions. (rcirc-print): Keep track of current line. Do not fill text if `rcirc-fill-flag' is null. Only omit text if the last activity from the sender is more than `rcirc-omit-threshold' lines ago. (rcirc-put-nick-channel, rcirc-handler-PRIVMSG): Track line numbers instead of time. (rcirc-channel-nicks): Sort by line numbers instead of time. (rcirc-omit-mode): Add `...' when omitting text and recenter. (rcirc-handler-JOIN): Restore the joiners linestamp. (rcirc-maybe-remember-nick-quit): Add function. (rcirc-handler-QUIT): Record sender in table of recently quit nicks.
author Glenn Morris <rgm@gnu.org>
date Mon, 29 Oct 2007 01:23:19 +0000
parents e811bd6ee020
children 2761adbcaf59
files lisp/net/rcirc.el
diffstat 1 files changed, 143 insertions(+), 49 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/net/rcirc.el	Mon Oct 29 01:21:16 2007 +0000
+++ b/lisp/net/rcirc.el	Mon Oct 29 01:23:19 2007 +0000
@@ -93,11 +93,11 @@
 when connecting to this server.  If absent, no channels will be
 connected to automatically."
   :type '(alist :key-type string
-		:value-type (plist :options ((nick string)
-					     (port integer)
-					     (user-name string)
-					     (full-name string)
-					     (channels (repeat 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
@@ -323,6 +323,9 @@
 
 (defvar rcirc-nick-table nil)
 
+(defvar rcirc-recent-quit-alist nil
+  "Alist of nicks that have recently quit or parted the channel.")
+
 (defvar rcirc-nick-syntax-table
   (let ((table (make-syntax-table text-mode-syntax-table)))
     (mapc (lambda (c) (modify-syntax-entry c "w" table))
@@ -417,8 +420,11 @@
 			      connected-servers))))))))
       (when connected-servers
 	(message "Already connected to %s"
-		 (concat (mapconcat 'identity (butlast connected-servers) ", ")
-			 ", and " (car (last connected-servers))))))))
+		 (if (cdr connected-servers)
+		     (concat (mapconcat 'identity (butlast connected-servers) ", ")
+			     ", and "
+			     (car (last connected-servers)))
+		   (car connected-servers)))))))
 
 ;;;###autoload
 (defalias 'irc 'rcirc)
@@ -763,7 +769,6 @@
 					  rcirc-target))))))
   (let ((completion (car rcirc-nick-completions)))
     (when completion
-      (rcirc-put-nick-channel (rcirc-buffer-process) completion rcirc-target)
       (delete-region (+ rcirc-prompt-end-marker
 			rcirc-nick-completion-start-offset)
 		     (point))
@@ -799,6 +804,7 @@
 (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 "M-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)
@@ -828,6 +834,10 @@
   "Alist of lines to log to disk when `rcirc-log-flag' is non-nil.
 Each element looks like (FILENAME . TEXT).")
 
+(defvar rcirc-current-line 0
+  "The current number of responses printed in this channel.
+This number is independent of the number of lines in the buffer.")
+
 (defun rcirc-mode (process target)
   "Major mode for IRC channel buffers.
 
@@ -850,12 +860,24 @@
   (setq rcirc-last-post-time (current-time))
   (make-local-variable 'fill-paragraph-function)
   (setq fill-paragraph-function 'rcirc-fill-paragraph)
+  (make-local-variable 'rcirc-recent-quit-alist)
+  (setq rcirc-recent-quit-alist nil)
+  (make-local-variable 'rcirc-current-line)
+  (setq rcirc-current-line 0)
 
   (make-local-variable 'rcirc-short-buffer-name)
   (setq rcirc-short-buffer-name nil)
   (make-local-variable 'rcirc-urls)
   (setq use-hard-newlines t)
 
+  ;; setup for omitting responses
+  (setq buffer-invisibility-spec '())
+  (setq buffer-display-table (make-display-table))
+  (set-display-table-slot buffer-display-table 4
+			  (let ((glyph (make-glyph-code 
+					?. 'font-lock-keyword-face)))
+			    (make-vector 3 glyph)))
+
   (make-local-variable 'rcirc-decode-coding-system)
   (make-local-variable 'rcirc-encode-coding-system)
   (dolist (i rcirc-coding-system-alist)
@@ -879,8 +901,6 @@
   (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)
@@ -1005,8 +1025,9 @@
 	(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)
+	    (rcirc-mode process target)
+	    (rcirc-put-nick-channel process (rcirc-nick process) target 
+				    rcirc-current-line))
 	  new-buffer)))))
 
 (defun rcirc-send-input ()
@@ -1090,7 +1111,8 @@
   (interactive)
   (let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
     (goto-char (point-max))
-    (let ((text (buffer-substring rcirc-prompt-end-marker (point)))
+    (let ((text (buffer-substring-no-properties rcirc-prompt-end-marker 
+						(point)))
           (parent (buffer-name)))
       (delete-region rcirc-prompt-end-marker (point))
       (setq rcirc-window-configuration (current-window-configuration))
@@ -1187,7 +1209,7 @@
   :group 'rcirc)
 
 (defcustom rcirc-omit-responses
-  '("JOIN" "PART" "QUIT")
+  '("JOIN" "PART" "QUIT" "NICK")
   "Responses which will be hidden when `rcirc-omit-mode' is enabled."
   :type '(repeat string)
   :group 'rcirc)
@@ -1281,6 +1303,38 @@
   :type 'boolean
   :group 'rcirc)
 
+(defcustom rcirc-omit-threshold 100
+  "Number of lines since last activity from a nick before `rcirc-omit-responses' are omitted."
+  :type 'integer
+  :group 'rcirc)
+
+(defun rcirc-last-quit-line (nick target)
+  "Return the line number where NICK left TARGET.
+Returns nil if the information is not recorded."
+  (let ((chanbuf (rcirc-get-buffer (rcirc-buffer-process) target)))
+    (when chanbuf
+      (cdr (assoc-string nick (with-current-buffer chanbuf
+				rcirc-recent-quit-alist))))))
+
+(defun rcirc-last-line (nick target)
+  "Return the line from the last activity from NICK in TARGET."
+  (let* ((chanbuf (rcirc-get-buffer (rcirc-buffer-process) target))
+	 (line (or (cdr (assoc-string target
+				      (gethash nick (with-rcirc-server-buffer
+						      rcirc-nick-table)) t))
+		   (rcirc-last-quit-line nick target))))
+    (if line
+	line
+      ;;(message "line is nil for %s in %s" nick target)
+      nil)))
+
+(defun rcirc-elapsed-lines (nick target)
+  "Return the number of lines since activity from NICK in TARGET."
+  (let ((last-activity-line (rcirc-last-line nick target)))
+    (when (and last-activity-line
+	       (> last-activity-line 0))
+      (- rcirc-current-line last-activity-line))))
+
 (defvar rcirc-markup-text-functions
   '(rcirc-markup-attributes
     rcirc-markup-my-nick
@@ -1305,7 +1359,8 @@
 			     (when (string-match "^\\([^/]\\w*\\)[:,]" text)
 			       (match-string 1 text)))
 			   rcirc-ignore-list))
-	       (not (string= sender (rcirc-nick process))))
+	       ;; do not ignore if we sent the message
+ 	       (not (string= sender (rcirc-nick process))))    
     (let* ((buffer (rcirc-target-buffer process sender response target text))
 	   (inhibit-read-only t))
       (with-current-buffer buffer
@@ -1340,6 +1395,9 @@
 							      'rcirc-text)
 				 rcirc-prompt-end-marker)))
 
+	    ;; increment the line count
+	    (setq rcirc-current-line (1+ rcirc-current-line))
+
 	    ;; run markup functions
  	    (save-excursion
  	      (save-restriction
@@ -1350,16 +1408,20 @@
 		  (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-fill-flag
+		    (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))))
+	      (let ((last-activity-lines (rcirc-elapsed-lines sender target)))
+		(when (and (not (string= (rcirc-nick process) sender))
+			   (member response rcirc-omit-responses)
+			   (or (not last-activity-lines)
+			       (< rcirc-omit-threshold last-activity-lines)))
+		  (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)
@@ -1470,15 +1532,20 @@
     (mapcar (lambda (x) (car x))
 	    (gethash nick rcirc-nick-table))))
 
-(defun rcirc-put-nick-channel (process nick channel)
-  "Add CHANNEL to list associated with NICK."
+(defun rcirc-put-nick-channel (process nick channel &optional line)
+  "Add CHANNEL to list associated with NICK.
+Update the associated linestamp if LINE is non-nil.
+
+If the record doesn't exist, and LINE is nil, set the linestamp
+to zero."
+  ;;(message "rcirc-put-nick-channel: %S %S %S" nick channel line)
   (let ((nick (rcirc-user-nick nick)))
     (with-rcirc-process-buffer process
       (let* ((chans (gethash nick rcirc-nick-table))
 	     (record (assoc-string channel chans t)))
 	(if record
-	    (setcdr record (current-time))
-	  (puthash nick (cons (cons channel (current-time))
+	    (when line (setcdr record line))
+	  (puthash nick (cons (cons channel (or line 0))
 			      chans)
 		   rcirc-nick-table))))))
 
@@ -1514,7 +1581,10 @@
 		     (setq nicks (cons (cons k (cdr record)) nicks)))))
 	     rcirc-nick-table)
 	    (mapcar (lambda (x) (car x))
-		    (sort nicks (lambda (x y) (time-less-p (cdr y) (cdr x)))))))
+		    (sort nicks (lambda (x y)
+				  (let ((lx (or (cdr x) 0))
+					(ly (or (cdr y) 0)))
+				    (< ly lx)))))))
       (list target))))
 
 (defun rcirc-ignore-update-automatic (nick)
@@ -1593,15 +1663,13 @@
 `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))
+  (if rcirc-omit-mode
+      (progn
+	(add-to-invisibility-spec '(rcirc-omit . t))
+	(message "Rcirc-Omit mode enabled"))
+    (remove-from-invisibility-spec '(rcirc-omit . t))
+    (message "Rcirc-Omit mode disabled"))
+    (recenter (when (> (point) rcirc-prompt-start-marker) -1)))
 
 (defun rcirc-switch-to-server-buffer ()
   "Switch to the server buffer associated with current channel buffer."
@@ -1636,7 +1704,10 @@
 	 (hipri (cdr pair)))
     (if (or (and (not arg) hipri)
 	    (and arg lopri))
-	(switch-to-buffer (car (if arg lopri hipri)) t)
+	(progn
+	  (switch-to-buffer (car (if arg lopri hipri)))
+	  (when (> (point) rcirc-prompt-start-marker)
+	    (recenter -1)))
       (if (eq major-mode 'rcirc-mode)
 	  (switch-to-buffer (rcirc-non-irc-buffer))
 	(message (concat
@@ -2201,9 +2272,9 @@
     (if (string-match "^\C-a\\(.*\\)\C-a$" message)
         (rcirc-handler-CTCP process target sender (match-string 1 message))
       (rcirc-print process sender "PRIVMSG" target message t))
-    ;; update nick timestamp
-    (if (member target (rcirc-nick-channels process sender))
-        (rcirc-put-nick-channel process sender target))))
+    ;; update nick linestamp
+    (with-current-buffer (rcirc-get-buffer process target t)
+      (rcirc-put-nick-channel process sender target rcirc-current-line))))
 
 (defun rcirc-handler-NOTICE (process sender args text)
   (let ((target (car args))
@@ -2228,21 +2299,29 @@
 
 (defun rcirc-handler-JOIN (process sender args text)
   (let ((channel (car args)))
-    (rcirc-get-buffer-create process channel)
+    (with-current-buffer (rcirc-get-buffer-create process channel)
+      ;; when recently rejoining, restore the linestamp
+      (rcirc-put-nick-channel process sender channel
+			      (let ((last-activity-lines
+				     (rcirc-elapsed-lines sender channel)))
+				(when (and last-activity-lines
+					   (< last-activity-lines rcirc-omit-threshold))
+				  (rcirc-last-line sender channel)))))
+
     (rcirc-print process sender "JOIN" channel "")
 
     ;; print in private chat buffer if it exists
     (when (rcirc-get-buffer (rcirc-buffer-process) sender)
-      (rcirc-print process sender "JOIN" sender channel))
-
-    (rcirc-put-nick-channel process sender channel)))
+      (rcirc-print process sender "JOIN" sender channel))))
 
 ;; PART and KICK are handled the same way
 (defun rcirc-handler-PART-or-KICK (process response channel sender nick args)
   (rcirc-ignore-update-automatic nick)
   (if (not (string= nick (rcirc-nick process)))
       ;; this is someone else leaving
-      (rcirc-remove-nick-channel process nick channel)
+      (progn
+	(rcirc-maybe-remember-nick-quit process nick channel)
+	(rcirc-remove-nick-channel process nick channel))
     ;; this is us leaving
     (mapc (lambda (n)
 	    (rcirc-remove-nick-channel process n channel))
@@ -2276,16 +2355,31 @@
 
     (rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason)))
 
+(defun rcirc-maybe-remember-nick-quit (process nick channel)
+  "Remember NICK as leaving CHANNEL if they recently spoke."
+  (let ((elapsed-lines (rcirc-elapsed-lines nick channel)))
+    (when (and elapsed-lines
+	       (< elapsed-lines rcirc-omit-threshold))
+      (let ((buffer (rcirc-get-buffer process channel)))
+	(when buffer
+	  (with-current-buffer buffer
+	    (let ((record (assoc-string nick rcirc-recent-quit-alist
+					t))
+		  (line (rcirc-last-line nick channel)))
+	      (if record
+		  (setcdr record line)
+		(setq rcirc-recent-quit-alist
+		      (cons (cons nick line)
+			    rcirc-recent-quit-alist))))))))))
+
 (defun rcirc-handler-QUIT (process sender args text)
   (rcirc-ignore-update-automatic sender)
   (mapc (lambda (channel)
-	  (rcirc-print process sender "QUIT" channel (apply 'concat args)))
+	  ;; broadcast quit message each channel
+	  (rcirc-print process sender "QUIT" channel (apply 'concat args))
+	  ;; record nick in quit table if they recently spoke
+	  (rcirc-maybe-remember-nick-quit process sender channel))
 	(rcirc-nick-channels process sender))
-
-  ;; print in private chat buffer if it exists
-  (when (rcirc-get-buffer (rcirc-buffer-process) sender)
-    (rcirc-print process sender "QUIT" sender (apply 'concat args)))
-
   (rcirc-nick-remove process sender))
 
 (defun rcirc-handler-NICK (process sender args text)