From: Ryan Yeske <rcyeske@gmail.com>
To: emacs-devel@gnu.org
Subject: rcirc update
Date: Mon, 22 Oct 2007 11:04:09 -0700 [thread overview]
Message-ID: <87sl43ni06.fsf@tarn.lan> (raw)
2007-10-22 Ryan Yeske <rcyeske@gmail.com>
* net/rcirc.el (rcirc-server-alist): Use coloned symbols for
paramater 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.
Index: rcirc.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/rcirc.el,v
retrieving revision 1.38
diff -c -r1.38 rcirc.el
*** rcirc.el 21 Oct 2007 00:24:31 -0000 1.38
--- rcirc.el 22 Oct 2007 18:03:34 -0000
***************
*** 93,103 ****
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)))))
:group 'rcirc)
(defcustom rcirc-default-port 6667
--- 93,103 ----
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)))))
:group 'rcirc)
(defcustom rcirc-default-port 6667
***************
*** 323,328 ****
--- 323,331 ----
(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,424 ****
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)
--- 420,430 ----
connected-servers))))))))
(when connected-servers
(message "Already connected to %s"
! (if (cdr connected-servers)
! (concat (mapconcat 'identity (butlast connected-servers) ", ")
! ", and "
! (car (last connected-servers)))
! (car connected-servers)))))))
;;;###autoload
(defalias 'irc 'rcirc)
***************
*** 763,769 ****
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))
--- 769,774 ----
***************
*** 799,804 ****
--- 804,810 ----
(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,833 ****
--- 834,843 ----
"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,861 ****
--- 860,883 ----
(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,886 ****
(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)
--- 901,906 ----
***************
*** 1005,1012 ****
(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 ()
--- 1025,1033 ----
(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-current-line))
new-buffer)))))
(defun rcirc-send-input ()
***************
*** 1090,1096 ****
(interactive)
(let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
(goto-char (point-max))
! (let ((text (buffer-substring rcirc-prompt-end-marker (point)))
(parent (buffer-name)))
(delete-region rcirc-prompt-end-marker (point))
(setq rcirc-window-configuration (current-window-configuration))
--- 1111,1118 ----
(interactive)
(let ((pos (1+ (- (point) rcirc-prompt-end-marker))))
(goto-char (point-max))
! (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,1193 ****
: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)
--- 1209,1215 ----
:group 'rcirc)
(defcustom rcirc-omit-responses
! '("JOIN" "PART" "QUIT" "NICK")
"Responses which will be hidden when `rcirc-omit-mode' is enabled."
:type '(repeat string)
:group 'rcirc)
***************
*** 1281,1286 ****
--- 1303,1340 ----
: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,1311 ****
(when (string-match "^\\([^/]\\w*\\)[:,]" text)
(match-string 1 text)))
rcirc-ignore-list))
! (not (string= sender (rcirc-nick process))))
(let* ((buffer (rcirc-target-buffer process sender response target text))
(inhibit-read-only t))
(with-current-buffer buffer
--- 1359,1366 ----
(when (string-match "^\\([^/]\\w*\\)[:,]" text)
(match-string 1 text)))
rcirc-ignore-list))
! ;; 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,1345 ****
--- 1395,1403 ----
'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,1365 ****
(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)
--- 1408,1427 ----
(save-excursion (rcirc-markup-timestamp sender response))
(dolist (fn rcirc-markup-text-functions)
(save-excursion (funcall fn 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
! (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,1484 ****
(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."
(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))
chans)
rcirc-nick-table))))))
--- 1532,1551 ----
(mapcar (lambda (x) (car x))
(gethash nick rcirc-nick-table))))
! (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
! (when line (setcdr record line))
! (puthash nick (cons (cons channel (or line 0))
chans)
rcirc-nick-table))))))
***************
*** 1514,1520 ****
(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)))))))
(list target))))
(defun rcirc-ignore-update-automatic (nick)
--- 1581,1590 ----
(setq nicks (cons (cons k (cdr record)) nicks)))))
rcirc-nick-table)
(mapcar (lambda (x) (car 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,1607 ****
`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."
--- 1663,1675 ----
`rcirc-omit-responses'."
(interactive)
(setq rcirc-omit-mode (not rcirc-omit-mode))
! (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,1642 ****
(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
--- 1704,1713 ----
(hipri (cdr pair)))
(if (or (and (not arg) hipri)
(and arg lopri))
! (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,2209 ****
(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))))
(defun rcirc-handler-NOTICE (process sender args text)
(let ((target (car args))
--- 2272,2280 ----
(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 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,2248 ****
(defun rcirc-handler-JOIN (process sender args text)
(let ((channel (car args)))
! (rcirc-get-buffer-create process 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)))
;; 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)
;; this is us leaving
(mapc (lambda (n)
(rcirc-remove-nick-channel process n channel))
--- 2299,2327 ----
(defun rcirc-handler-JOIN (process sender args text)
(let ((channel (car args)))
! (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))))
;; 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
! (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,2291 ****
(rcirc-handler-PART-or-KICK process "KICK" channel sender nick reason)))
(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)))
(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)
--- 2355,2385 ----
(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)
! ;; 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))
(rcirc-nick-remove process sender))
(defun rcirc-handler-NICK (process sender args text)
Diffs between working revision and workfile end here.
next reply other threads:[~2007-10-22 18:04 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2007-10-22 18:04 Ryan Yeske [this message]
2007-10-29 1:25 ` rcirc update Glenn Morris
2007-10-31 5:21 ` Ryan Yeske
2007-11-01 4:04 ` Glenn Morris
-- strict thread matches above, loose matches on Subject: below --
2009-10-02 0:11 Ryan Yeske
2009-10-15 6:50 ` Glenn Morris
2007-06-09 5:21 Ryan Yeske
2007-06-13 20:30 ` Chong Yidong
2007-06-13 21:17 ` Stefan Monnier
2007-06-16 3:02 ` Ryan Yeske
2007-06-16 3:58 ` Miles Bader
2007-06-16 5:08 ` Ryan Yeske
2007-06-16 21:26 ` Miles Bader
2007-06-17 23:33 ` Ryan Yeske
2007-06-20 19:53 ` Ryan Yeske
2007-06-28 9:51 ` Ryan Yeske
2007-06-29 0:54 ` Miles Bader
2007-06-29 7:34 ` Thien-Thi Nguyen
2007-03-07 23:14 Ryan Yeske
2006-09-02 0:02 Ryan Yeske
2006-08-20 17:50 Ryan Yeske
2006-08-21 5:36 ` Miles Bader
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87sl43ni06.fsf@tarn.lan \
--to=rcyeske@gmail.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).