Function: rcirc-print

rcirc-print is a byte-compiled function defined in rcirc.el.gz.

Signature

(rcirc-print PROCESS SENDER RESPONSE TARGET TEXT &optional ACTIVITY)

Documentation

Print TEXT in the buffer associated with TARGET.

Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, record activity. PROCESS is the process object for the current connection.

Source Code

;; Defined in /usr/src/emacs/lisp/net/rcirc.el.gz
(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.  PROCESS is the process object for the current
connection."
  (or text (setq text ""))
  (unless (and (or (member sender rcirc-ignore-list)
		   (member (with-syntax-table rcirc-nick-syntax-table
			     (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))
           (time (if-let ((time (rcirc-get-tag "time")))
                     (parse-iso8601-time-string time)
                   (current-time)))
	   (inhibit-read-only t))
      (with-current-buffer buffer
	(let ((moving (= (point) rcirc-prompt-end-marker))
	      (old-point (point-marker)))

	  (setq text (decode-coding-string text rcirc-decode-coding-system))
	  (unless (string= sender (rcirc-nick process))
	    ;; mark the line with overlay arrow
	    (unless (or (marker-position overlay-arrow-position)
			(get-buffer-window (current-buffer))
			(member response rcirc-omit-responses))
	      (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)
          (catch 'exit
            (while (not (bobp))
              (goto-char (or (previous-single-property-change (point) 'hard)
                             (point-min)))
              (when (let ((then (get-text-property (point) 'rcirc-time)))
                      (and then (not (time-less-p time then))))
                (next-single-property-change (point) 'hard)
                (forward-char 1)
                (throw 'exit nil))))
	  (set-marker-insertion-type rcirc-prompt-start-marker t)
	  (set-marker-insertion-type rcirc-prompt-end-marker t)

          ;; run markup functions
          (cl-assert (bolp))
          (save-excursion
            (save-restriction
              (narrow-to-region (point) (point))
              (insert (propertize (rcirc-format-response-string process sender response
                                                              nil text)
                                'rcirc-msgid (rcirc-get-tag "msgid"))
		      (propertize "\n" 'hard t))

              ;; squeeze spaces out of text before rcirc-text
              (fill-region (point-min) (point-max))

              (goto-char (or (next-single-property-change (point-min) 'rcirc-text)
			       (point)))
		(when (rcirc-buffer-process)
		  (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)))

              (add-text-properties (point-min) (point-max)
                                   (list 'rcirc-time time))

              ;; make text omittable
	      (let ((last-activity-lines (rcirc-elapsed-lines process sender target)))
		(if (and (not (string= (rcirc-nick process) sender))
                         (or (member response rcirc-omit-responses)
                             (and (member response rcirc-omit-unless-requested)
                                  (if (member response rcirc-pending-requests)
                                      (ignore (setq rcirc-pending-requests
                                                    (delete response rcirc-pending-requests)))
                                    t)))
                         (or (member response rcirc-omit-unless-requested)
                             (not last-activity-lines)
                             (< rcirc-omit-threshold last-activity-lines)))
                  (put-text-property (point-min) (point-max)
				       '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
	  (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)
			  (when (and (not (eq (selected-window) w))
				     (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)))

	  ;; keep window on bottom line if it was already there
	  (when rcirc-scroll-show-maximum-output
	    (let ((window (get-buffer-window)))
	      (when window
		(with-selected-window window
		  (when (eq major-mode 'rcirc-mode)
		    (when (<= (- (window-height)
				 (count-screen-lines (window-point)
						     (window-start))
				 1)
			      0)
		      (recenter -1)))))))

	  ;; flush undo (can we do something smarter here?)
	  (buffer-disable-undo)
	  (buffer-enable-undo)

        ;; record mode line activity
        (when (and activity
                   (not rcirc-ignore-buffer-activity-flag)
                   (not (and rcirc-dim-nicks sender
                             (string-match (regexp-opt rcirc-dim-nicks) sender)
                             (rcirc-channel-p target))))
            (rcirc-record-activity (current-buffer)
                                   (when (not (rcirc-channel-p rcirc-target))
                                     'nick)))

        (when (and rcirc-log-flag
                   (or target
                       rcirc-log-process-buffers))
          (rcirc-log process sender response target text))

        (sit-for 0)			; displayed text before hook
        (run-hook-with-args 'rcirc-print-functions
                            process sender response target text)))))