emacs-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

rcirc update


From: Ryan Yeske
Subject: rcirc update
Date: Mon, 22 Oct 2007 11:04:09 -0700

2007-10-22  Ryan Yeske  <address@hidden>

        * 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.




reply via email to

[Prev in Thread] Current Thread [Next in Thread]