allow editing messages after they are submitted in rcirc

rcirc-pending.el

;;; rcirc-pending.el --- allow editing messages after they are submitted                                                                                                                                                                                                                                                                                                                                                               
;; Author: Ryan Yeske <[email protected]>                                                                                                                                                                                                                                                                                                                                                                                            
;; Keywords: comm                                                                                                                                                                                                                                                                                                                                                                                                                      

(defvar rcirc-pending-delay 5
  "Delay in seconds before sending message.")

(define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-pending)

(defun rcirc-pending-markup (sender response)
  (add-text-properties (point-min) (point-max) '(face highlight pending t)))

(defun rcirc-delete-pending-text ()
  (let ((inhibit-read-only t))
    (dolist (region (rcirc-find-text-property-region (point-min) (point-max) 'pending))
      (delete-region (car region) (cadr region)))))

(defun rcirc-queue-message (process response target message)
  (setq rcirc-pending-message message)
  (run-at-time rcirc-pending-delay nil 'rcirc-send-pending-message process response target))

(defun rcirc-send-pending-message (process response target)
  (with-current-buffer (rcirc-get-buffer-create process target)
    (when rcirc-pending-message
      ;; remove text that was marked up as pending                                                                                                                                                                                                                                                                                                                                                                                     
      (rcirc-delete-pending-text)

      ;; send it, and print it again                                                                                                                                                                                                                                                                                                                                                                                                   
      (dolist (msg (rcirc-split-message rcirc-pending-message))
        (rcirc-send-string process response target : msg)
        (rcirc-print process (rcirc-nick process) response target msg))

      ;; clear the pending message                                                                                                                                                                                                                                                                                                                                                                                                     
      (setq rcirc-pending-message nil))))

(defvar rcirc-pending-message nil)

(defun rcirc-send-message (process target message &optional noticep silent)
  "Send TARGET associated with PROCESS a privmsg with text MESSAGE.                                                                                                                                                                                                                                                                                                                                                                    
If NOTICEP is non-nil, send a notice instead of privmsg.                                                                                                                                                                                                                                                                                                                                                                               
If SILENT is non-nil, do not print the message in any irc buffer."
  (let ((response (if noticep "NOTICE" "PRIVMSG")))
    (with-current-buffer (rcirc-get-buffer-create process target)
      (make-variable-buffer-local 'rcirc-pending-message)

      ;; TODO handle silent                                                                                                                                                                                                                                                                                                                                                                                                            

      ;; deliver any pending messages before handling this one                                                                                                                                                                                                                                                                                                                                                                         
      (rcirc-send-pending-message process response target)

      ;; save current message to send later                                                                                                                                                                                                                                                                                                                                                                                            
      (rcirc-queue-message process response target message)

      ;; print it, but mark it up to indicate its not yet sent                                                                                                                                                                                                                                                                                                                                                                         
      (let ((rcirc-markup-text-functions '(rcirc-pending-markup)))
        (rcirc-print process (rcirc-nick process) response target message)))))

(defun rcirc-edit-pending ()
  (interactive)
  (let ((pending rcirc-pending-message))
    (setq rcirc-pending-message nil)
    (rcirc-delete-pending-text)
    (rcirc-edit-multiline)
    (when pending
      (goto-char (point-min))
      (insert pending))))

;; copy of gnus-find-text-property-region in gnus-util.el                                                                                                                                                                                                                                                                                                                                                                              
(defun rcirc-find-text-property-region (start end prop)
  "Return a list of text property regions that has property PROP."
  (let (regions value)
    (unless (get-text-property start prop)
      (setq start (next-single-property-change start prop)))
    (while start
      (setq value (get-text-property start prop)
            end (text-property-not-all start (point-max) prop value))
      (if (not end)
          (setq start nil)
        (when value
          (push (list (set-marker (make-marker) start)
                      (set-marker (make-marker) end)
                      value)
                regions))
        (setq start (next-single-property-change start prop))))
    (nreverse regions)))