comparison lisp/net/rcirc.el @ 85854:41cfd60a7993

Ryan Yeske <rcyeske at gmail.com> (rcirc-last-quit-line, rcirc-last-line) (rcirc-elapsed-lines): New argument PROCESS. Update callers. (rcirc-print): Only update the line count when not marking the line as ommittable. (rcirc-log-write): Specify coding system when writing logfile. (rcirc-markup-fill): Make sure ellipsis does not cause line to wrap.

85853:6d6c35a3f25a

(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
    rcirc-markup-urls
    rcirc-markup-keywords
    rcirc-markup-bright-nicks
    rcirc-markup-fill)

  "List of functions used to manipulate text before it is printed.

Each function takes two arguments, SENDER, RESPONSE.  The buffer
is narrowed with the text to be printed and the point is at the
beginning of the `rcirc-text' propertized text.")

(defun rcirc-print (process sender response target text &optional activity)
  "Print TEXT in the buffer associated with TARGET.
Format based on SENDER and RESPONSE.  If ACTIVITY is non-nil,
record activity."

	    (fill-region fill-start
			 (1- (or (next-single-property-change fill-start
							      '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
 		(narrow-to-region start rcirc-prompt-start-marker)
		(goto-char (or (next-single-property-change start 'rcirc-text)

		(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)

	  ;; truncate buffer if it is very long

Log data is written to `rcirc-log-directory'."
  (make-directory rcirc-log-directory t)
  (dolist (cell rcirc-log-alist)
    (with-temp-buffer
      (insert (cdr cell))
      (write-region (point-min) (point-max)
		    (concat rcirc-log-directory "/" (car cell))
		    t 'quiet)))
  (setq rcirc-log-alist nil))

(defun rcirc-join-channels (process channels)
  "Join CHANNELS."
  (save-window-excursion

  "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

(defun rcirc-markup-fill (sender response)
  (when (not (string= response "372")) 	; /motd
    (let ((fill-prefix
	   (or rcirc-fill-prefix
	       (make-string (- (point) (line-beginning-position)) ?\s)))
	  (fill-column (cond ((eq rcirc-fill-column 'frame-width)
			      (1- (frame-width)))
			     (rcirc-fill-column
			      rcirc-fill-column)
			     (t fill-column))))
      (fill-region (point) (point-max) nil t))))

;;; handlers
;; these are called with the server PROCESS, the SENDER, which is a
;; server or a user, depending on the command, the ARGS, which is a
;; list of strings, and the TEXT, which is the original server text,
;; verbatim
(defun rcirc-handler-001 (process sender args text)
  (rcirc-handler-generic process "001" sender args text)
  ;; set the real server name
  (with-rcirc-process-buffer process
    (setq rcirc-connecting nil)
    (rcirc-reschedule-timeout process)
    (setq rcirc-server-name sender)
    (setq rcirc-nick (car args))

  (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-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))))))))))

85854:41cfd60a7993

(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 (process nick target)
  "Return the line number where NICK left TARGET.
Returns nil if the information is not recorded."
  (let ((chanbuf (rcirc-get-buffer process target)))
    (when chanbuf
      (cdr (assoc-string nick (with-current-buffer chanbuf
				rcirc-recent-quit-alist))))))

(defun rcirc-last-line (process nick target)
  "Return the line from the last activity from NICK in TARGET."
  (let* ((chanbuf (rcirc-get-buffer process target))
	 (line (or (cdr (assoc-string target
				      (gethash nick (with-rcirc-server-buffer
						      rcirc-nick-table)) t))
		   (rcirc-last-quit-line process nick target))))
    (if line
	line
      ;;(message "line is nil for %s in %s" nick target)
      nil)))

(defun rcirc-elapsed-lines (process nick target)
  "Return the number of lines since activity from NICK in TARGET."
  (let ((last-activity-line (rcirc-last-line process 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
    rcirc-markup-urls
    rcirc-markup-keywords
    rcirc-markup-bright-nicks)

  "List of functions used to manipulate text before it is printed.

Each function takes two arguments, SENDER, and RESPONSE.  The
buffer is narrowed with the text to be printed and the point is
at the beginning of the `rcirc-text' propertized text.")

(defun rcirc-print (process sender response target text &optional activity)
  "Print TEXT in the buffer associated with TARGET.
Format based on SENDER and RESPONSE.  If ACTIVITY is non-nil,
record activity."

	    (fill-region fill-start
			 (1- (or (next-single-property-change fill-start
							      'rcirc-text)
				 rcirc-prompt-end-marker)))

	    ;; run markup functions
 	    (save-excursion
 	      (save-restriction
 		(narrow-to-region start rcirc-prompt-start-marker)
		(goto-char (or (next-single-property-change start 'rcirc-text)

		(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 process sender target)))
		(if (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)
		  ;; otherwise increment the line count
		  (setq rcirc-current-line (1+ rcirc-current-line))))))

	  (set-marker-insertion-type rcirc-prompt-start-marker nil)
	  (set-marker-insertion-type rcirc-prompt-end-marker nil)

	  ;; truncate buffer if it is very long

Log data is written to `rcirc-log-directory'."
  (make-directory rcirc-log-directory t)
  (dolist (cell rcirc-log-alist)
    (with-temp-buffer
      (insert (cdr cell))
      (let ((coding-system-for-write 'utf-8))
	(write-region (point-min) (point-max)
		      (concat rcirc-log-directory "/" (car cell))
		      t 'quiet))))
  (setq rcirc-log-alist nil))

(defun rcirc-join-channels (process channels)
  "Join CHANNELS."
  (save-window-excursion

  "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."
  (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

(defun rcirc-markup-fill (sender response)
  (when (not (string= response "372")) 	; /motd
    (let ((fill-prefix
	   (or rcirc-fill-prefix
	       (make-string (- (point) (line-beginning-position)) ?\s)))
	  (fill-column (- (cond ((eq rcirc-fill-column 'frame-width)
				 (1- (frame-width)))
				(rcirc-fill-column
				 rcirc-fill-column)
				(t fill-column))
			  ;; make sure ... doesn't cause line wrapping
			  3)))		
      (fill-region (point) (point-max) nil t))))

;;; handlers
;; these are called with the server PROCESS, the SENDER, which is a
;; server or a user, depending on the command, the ARGS, which is a
;; list of strings, and the TEXT, which is the original server text,
;; verbatim
(defun rcirc-handler-001 (process sender args text)
  (rcirc-handler-generic process "001" sender args text)
  (with-rcirc-process-buffer process
    (setq rcirc-connecting nil)
    (rcirc-reschedule-timeout process)
    (setq rcirc-server-name sender)
    (setq rcirc-nick (car args))

  (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 process sender channel)))
				(when (and last-activity-lines
					   (< last-activity-lines rcirc-omit-threshold))
				  (rcirc-last-line process 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-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 process 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 process nick channel)))
	      (if record
		  (setcdr record line)
		(setq rcirc-recent-quit-alist
		      (cons (cons nick line)
			    rcirc-recent-quit-alist))))))))))