Function: gnus-uu-post-encoded

gnus-uu-post-encoded is a byte-compiled function defined in gnus-uu.el.gz.

Signature

(gnus-uu-post-encoded FILE-NAME &optional THREADED)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/gnus-uu.el.gz
;; Posts the article and all of the encoded file.
(defun gnus-uu-post-encoded (file-name &optional threaded)
  (let ((send-buffer-name "*uuencode send buffer*")
	(encoded-buffer-name "*encoded buffer*")
	(top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
	(separator (concat mail-header-separator "\n\n"))
	uubuf length parts header i end beg
	beg-line minlen post-buf whole-len beg-binary end-binary)

    (setq post-buf (current-buffer))

    (goto-char (point-min))
    (when (not (re-search-forward
		(if gnus-uu-post-separate-description
		    (concat "^" (regexp-quote gnus-uu-post-binary-separator)
			    "$")
		  (concat "^" (regexp-quote mail-header-separator) "$"))
		nil t))
      (error "Internal error: No binary/header separator"))
    (beginning-of-line)
    (forward-line 1)
    (setq beg-binary (point))
    (setq end-binary (point-max))

    (with-current-buffer
	(setq uubuf (gnus-get-buffer-create encoded-buffer-name))
      (erase-buffer)
      (insert-buffer-substring post-buf beg-binary end-binary)
      (goto-char (point-min))
      (setq length (count-lines (point-min) (point-max)))
      (setq parts (/ length gnus-uu-post-length))
      (unless (< (% length gnus-uu-post-length) 4)
	(cl-incf parts)))

    (when gnus-uu-post-separate-description
      (forward-line -1))
    (delete-region (point) (point-max))

    (goto-char (point-min))
    (re-search-forward
     (concat "^" (regexp-quote mail-header-separator) "$") nil t)
    (setq header (buffer-substring (point-min) (point-at-bol)))

    (goto-char (point-min))
    (when gnus-uu-post-separate-description
      (when (re-search-forward "^Subject: " nil t)
	(end-of-line)
	(insert (format " (0/%d)" parts)))
      (save-excursion
	(message-send))
      (setq gnus-uu-post-message-id (message-fetch-field "message-id")))

    (save-excursion
      (setq i 1)
      (setq beg 1)
      (while (not (> i parts))
	(set-buffer (gnus-get-buffer-create send-buffer-name))
	(erase-buffer)
	(insert header)
	(when (and threaded gnus-uu-post-message-id)
	  (insert "References: " gnus-uu-post-message-id "\n"))
	(insert separator)
	(setq whole-len
	      (- 62 (length (format top-string "" file-name i parts ""))))
	(when (> 1 (setq minlen (/ whole-len 2)))
	  (setq minlen 1))
	(setq
	 beg-line
	 (format top-string
		 (make-string minlen ?-)
		 file-name i parts
		 (make-string
		  (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))

	(goto-char (point-min))
	(when (re-search-forward "^Subject: " nil t)
	  (end-of-line)
	  (insert (format " (%d/%d)" i parts)))

	(goto-char (point-max))
	(with-current-buffer uubuf
	  (goto-char beg)
	  (if (= i parts)
	      (goto-char (point-max))
	    (forward-line gnus-uu-post-length))
	  (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
	    (forward-line -4))
	  (setq end (point)))
	(insert-buffer-substring uubuf beg end)
	(insert beg-line "\n")
	(setq beg end)
	(cl-incf i)
	(goto-char (point-min))
	(re-search-forward
	 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
	(beginning-of-line)
	(forward-line 2)
	(when (re-search-forward
	       (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
	       nil t)
	  (replace-match "")
	  (forward-line 1))
	(insert beg-line)
	(insert "\n")
	(let (message-sent-message-via)
	  (save-excursion
	    (message-send))
	  (setq gnus-uu-post-message-id
		(concat (message-fetch-field "references") " "
			(message-fetch-field "message-id"))))))

    (gnus-kill-buffer send-buffer-name)
    (gnus-kill-buffer encoded-buffer-name)

    (when (not gnus-uu-post-separate-description)
      (set-buffer-modified-p nil)
      (bury-buffer))))