*** pub/pgnus/lisp/gnus-uu.el Sat Aug 29 19:58:29 1998 --- pgnus/lisp/gnus-uu.el Sat Aug 29 20:01:02 1998 *************** *** 1287,2044 **** (not (memq 'end process-state)) result-file (file-exists-p result-file) ! (not gnus-uu-be-dangerous) ! (or (eq gnus-uu-be-dangerous t) ! (gnus-y-or-n-p ! (format "Delete incomplete file %s? " result-file))) ! (delete-file result-file)) ! ! ;; If this was a file of the wrong sort, then ! (when (and (or (memq 'wrong-type process-state) ! (memq 'error process-state)) ! gnus-uu-unmark-articles-not-decoded) ! (gnus-summary-tick-article article t)) ! ! ;; Set the new series state. ! (if (and (not has-been-begin) ! (not sloppy) ! (or (memq 'end process-state) ! (memq 'middle process-state))) ! (progn ! (setq process-state (list 'error)) ! (gnus-message 2 "No begin part at the beginning") ! (sleep-for 2)) ! (setq state 'middle))) ! ! ;; When there are no result-files, then something must be wrong. ! (if result-files ! (message "") ! (cond ! ((not has-been-begin) ! (gnus-message 2 "Wrong type file")) ! ((memq 'error process-state) ! (gnus-message 2 "An error occurred during decoding")) ! ((not (or (memq 'ok process-state) ! (memq 'end process-state))) ! (gnus-message 2 "End of articles reached before end of file"))) ! ;; Make unsuccessfully decoded articles unread. ! (when gnus-uu-unmark-articles-not-decoded ! (while article-series ! (gnus-summary-tick-article (pop article-series) t))))) ! ! result-files)) ! ! (defun gnus-uu-grab-view (file) ! "View FILE using the gnus-uu methods." ! (let ((action (gnus-uu-get-action file))) ! (gnus-execute-command ! (if (string-match "%" action) ! (format action file) ! (concat action " " file)) ! (eq gnus-view-pseudos 'not-confirm)))) ! ! (defun gnus-uu-grab-move (file) ! "Move FILE to somewhere." ! (when gnus-uu-default-dir ! (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) ! (file-name-nondirectory file)))) ! (rename-file file to-file) ! (unless (file-exists-p file) ! (make-symbolic-link to-file file))))) ! ! (defun gnus-uu-part-number (article) ! (let* ((header (gnus-summary-article-header article)) ! (subject (and header (mail-header-subject header))) ! (part nil)) ! (if subject ! (while (string-match "[0-9]+/[0-9]+\\|[0-9]+[ \t]+of[ \t]+[0-9]+" ! subject) ! (setq part (match-string 0 subject)) ! (setq subject (substring subject (match-end 0))))) ! (or part ! (while (string-match "\\([0-9]+\\)[^0-9]+\\([0-9]+\\)" subject) ! (setq part (match-string 0 subject)) ! (setq subject (substring subject (match-end 0))))) ! (or part ""))) ! ! (defun gnus-uu-uudecode-sentinel (process event) ! (delete-process (get-process process))) ! ! (defun gnus-uu-uustrip-article (process-buffer in-state) ! ;; Uudecodes a file asynchronously. ! (save-excursion ! (set-buffer process-buffer) ! (let ((state (list 'wrong-type)) ! process-connection-type case-fold-search buffer-read-only ! files start-char) ! (goto-char (point-min)) ! ! ;; Deal with ^M at the end of the lines. ! (when gnus-uu-kill-carriage-return ! (save-excursion ! (while (search-forward "\r" nil t) ! (delete-backward-char 1)))) ! ! (while (or (re-search-forward gnus-uu-begin-string nil t) ! (re-search-forward gnus-uu-body-line nil t)) ! (setq state (list 'ok)) ! ;; Ok, we are at the first uucoded line. ! (beginning-of-line) ! (setq start-char (point)) ! ! (if (not (looking-at gnus-uu-begin-string)) ! (setq state (list 'middle)) ! ;; This is the beginning of a uuencoded article. ! ;; We replace certain characters that could make things messy. ! (setq gnus-uu-file-name ! (let ((nnheader-file-name-translation-alist ! '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) ! (nnheader-translate-file-chars (match-string 1)))) ! (replace-match (concat "begin 644 " gnus-uu-file-name) t t) ! ! ;; Remove any non gnus-uu-body-line right after start. ! (forward-line 1) ! (while (and (not (eobp)) ! (not (looking-at gnus-uu-body-line))) ! (gnus-delete-line)) ! ! ;; If a process is running, we kill it. ! (when (and gnus-uu-uudecode-process ! (memq (process-status gnus-uu-uudecode-process) ! '(run stop))) ! (delete-process gnus-uu-uudecode-process) ! (gnus-uu-unmark-list-of-grabbed t)) ! ! ;; Start a new uudecoding process. ! (let ((cdir default-directory)) ! (unwind-protect ! (progn ! (cd gnus-uu-work-dir) ! (setq gnus-uu-uudecode-process ! (start-process ! "*uudecode*" ! (gnus-get-buffer-create gnus-uu-output-buffer-name) ! shell-file-name shell-command-switch ! (format "cd %s %s uudecode" gnus-uu-work-dir ! gnus-shell-command-separator)))) ! (cd cdir))) ! (set-process-sentinel ! gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) ! (setq state (list 'begin)) ! (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) ! ! ;; We look for the end of the thing to be decoded. ! (if (re-search-forward gnus-uu-end-string nil t) ! (push 'end state) ! (goto-char (point-max)) ! (re-search-backward gnus-uu-body-line nil t)) ! ! (forward-line 1) ! ! (when gnus-uu-uudecode-process ! (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) ! ;; Try to correct mishandled uucode. ! (when gnus-uu-correct-stripped-uucode ! (gnus-uu-check-correct-stripped-uucode start-char (point))) ! (gnus-run-hooks 'gnus-uu-pre-uudecode-hook) ! ! ;; Send the text to the process. ! (condition-case nil ! (process-send-region ! gnus-uu-uudecode-process start-char (point)) ! (error ! (progn ! (delete-process gnus-uu-uudecode-process) ! (gnus-message 2 "gnus-uu: Couldn't uudecode") ! (setq state (list 'wrong-type))))) ! ! (if (memq 'end state) ! (progn ! ;; Send an EOF, just in case. ! (ignore-errors ! (process-send-eof gnus-uu-uudecode-process)) ! (while (memq (process-status gnus-uu-uudecode-process) ! '(open run)) ! (accept-process-output gnus-uu-uudecode-process 1))) ! (when (or (not gnus-uu-uudecode-process) ! (not (memq (process-status gnus-uu-uudecode-process) ! '(run stop)))) ! (setq state (list 'wrong-type))))))) ! ! (if (memq 'begin state) ! (cons (if (= (length files) 1) (car files) files) state) ! state)))) ! ! ;; This function is used by `gnus-uu-grab-articles' to treat ! ;; a shared article. ! (defun gnus-uu-unshar-article (process-buffer in-state) ! (let ((state (list 'ok)) ! start-char) ! (save-excursion ! (set-buffer process-buffer) ! (goto-char (point-min)) ! (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) ! (setq state (list 'wrong-type)) ! (beginning-of-line) ! (setq start-char (point)) ! (call-process-region ! start-char (point-max) shell-file-name nil ! (gnus-get-buffer-create gnus-uu-output-buffer-name) nil ! shell-command-switch ! (concat "cd " gnus-uu-work-dir " " ! gnus-shell-command-separator " sh")))) ! state)) ! ! ;; Returns the name of what the shar file is going to unpack. ! (defun gnus-uu-find-name-in-shar () ! (let ((oldpoint (point)) ! res) ! (goto-char (point-min)) ! (when (re-search-forward gnus-uu-shar-name-marker nil t) ! (setq res (buffer-substring (match-beginning 1) (match-end 1)))) ! (goto-char oldpoint) ! res)) ! ! ;; `gnus-uu-choose-action' chooses what action to perform given the name ! ;; and `gnus-uu-file-action-list'. Returns either nil if no action is ! ;; found, or the name of the command to run if such a rule is found. ! (defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) ! (let ((action-list (copy-sequence file-action-list)) ! (case-fold-search t) ! rule action) ! (and ! (unless no-ignore ! (and (not ! (and gnus-uu-ignore-files-by-name ! (string-match gnus-uu-ignore-files-by-name file-name))) ! (not ! (and gnus-uu-ignore-files-by-type ! (string-match gnus-uu-ignore-files-by-type ! (or (gnus-uu-choose-action ! file-name gnus-uu-ext-to-mime-list t) ! "")))))) ! (while (not (or (eq action-list ()) action)) ! (setq rule (car action-list)) ! (setq action-list (cdr action-list)) ! (when (string-match (car rule) file-name) ! (setq action (cadr rule))))) ! action)) ! ! (defun gnus-uu-treat-archive (file-path) ! ;; Unpacks an archive. Returns t if unpacking is successful. ! (let ((did-unpack t) ! action command dir) ! (setq action (gnus-uu-choose-action ! file-path (append gnus-uu-user-archive-rules ! (if gnus-uu-ignore-default-archive-rules ! nil ! gnus-uu-default-archive-rules)))) ! ! (when (not action) ! (error "No unpackers for the file %s" file-path)) ! ! (string-match "/[^/]*$" file-path) ! (setq dir (substring file-path 0 (match-beginning 0))) ! ! (when (member action gnus-uu-destructive-archivers) ! (copy-file file-path (concat file-path "~") t)) ! ! (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) ! ! (save-excursion ! (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) ! (erase-buffer)) ! ! (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) ! ! (if (= 0 (call-process shell-file-name nil ! (gnus-get-buffer-create gnus-uu-output-buffer-name) ! nil shell-command-switch command)) ! (message "") ! (gnus-message 2 "Error during unpacking of archive") ! (setq did-unpack nil)) ! ! (when (member action gnus-uu-destructive-archivers) ! (rename-file (concat file-path "~") file-path t)) ! ! did-unpack)) ! ! (defun gnus-uu-dir-files (dir) ! (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$")) ! files file) ! (while dirs ! (if (file-directory-p (setq file (car dirs))) ! (setq files (append files (gnus-uu-dir-files file))) ! (push file files)) ! (setq dirs (cdr dirs))) ! files)) ! ! (defun gnus-uu-unpack-files (files &optional ignore) ! ;; Go through FILES and look for files to unpack. ! (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) ! (ofiles files) ! file did-unpack) ! (while files ! (setq file (cdr (assq 'name (car files)))) ! (when (and (not (member file ignore)) ! (equal (gnus-uu-get-action (file-name-nondirectory file)) ! "gnus-uu-archive")) ! (push file did-unpack) ! (unless (gnus-uu-treat-archive file) ! (gnus-message 2 "Error during unpacking of %s" file)) ! (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) ! (nfiles newfiles)) ! (while nfiles ! (unless (member (car nfiles) totfiles) ! (push (list (cons 'name (car nfiles)) ! (cons 'original file)) ! ofiles)) ! (setq nfiles (cdr nfiles))) ! (setq totfiles newfiles))) ! (setq files (cdr files))) ! (if did-unpack ! (gnus-uu-unpack-files ofiles (append did-unpack ignore)) ! ofiles))) ! ! (defun gnus-uu-ls-r (dir) ! (let* ((files (gnus-uu-directory-files dir t)) ! (ofiles files)) ! (while files ! (when (file-directory-p (car files)) ! (setq ofiles (delete (car files) ofiles)) ! (setq ofiles (append ofiles (gnus-uu-ls-r (car files))))) ! (setq files (cdr files))) ! ofiles)) ! ! ;; Various stuff ! ! (defun gnus-uu-directory-files (dir &optional full) ! (let (files out file) ! (setq files (directory-files dir full)) ! (while files ! (setq file (car files)) ! (setq files (cdr files)) ! (unless (member (file-name-nondirectory file) '("." "..")) ! (push file out))) ! (setq out (nreverse out)) ! out)) ! ! (defun gnus-uu-check-correct-stripped-uucode (start end) ! (save-excursion ! (let (found beg length) ! (if (not gnus-uu-correct-stripped-uucode) ! () ! (goto-char start) ! ! (if (re-search-forward " \\|`" end t) ! (progn ! (goto-char start) ! (while (not (eobp)) ! (progn ! (when (looking-at "\n") ! (replace-match "")) ! (forward-line 1)))) ! ! (while (not (eobp)) ! (if (looking-at (concat gnus-uu-begin-string "\\|" ! gnus-uu-end-string)) ! () ! (when (not found) ! (beginning-of-line) ! (setq beg (point)) (end-of-line) ! (setq length (- (point) beg))) ! (setq found t) ! (beginning-of-line) ! (setq beg (point)) ! (end-of-line) ! (when (not (= length (- (point) beg))) ! (insert (make-string (- length (- (point) beg)) ? )))) ! (forward-line 1))))))) ! ! (defvar gnus-uu-tmp-alist nil) ! ! (defun gnus-uu-initialize (&optional scan) ! (let (entry) ! (if (and (not scan) ! (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) ! (if (file-exists-p (cdr entry)) ! (setq gnus-uu-work-dir (cdr entry)) ! (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) ! nil))) ! t ! (setq gnus-uu-tmp-dir (file-name-as-directory ! (expand-file-name gnus-uu-tmp-dir))) ! (if (not (file-directory-p gnus-uu-tmp-dir)) ! (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) ! (when (not (file-writable-p gnus-uu-tmp-dir)) ! (error "Temp directory %s can't be written to" ! gnus-uu-tmp-dir))) ! ! (setq gnus-uu-work-dir ! (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) ! (gnus-make-directory gnus-uu-work-dir) ! (set-file-modes gnus-uu-work-dir 448) ! (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) ! (push (cons gnus-newsgroup-name gnus-uu-work-dir) ! gnus-uu-tmp-alist)))) ! ! ! ;; Kills the temporary uu buffers, kills any processes, etc. ! (defun gnus-uu-clean-up () ! (let (buf) ! (and gnus-uu-uudecode-process ! (memq (process-status (or gnus-uu-uudecode-process "nevair")) ! '(stop run)) ! (delete-process gnus-uu-uudecode-process)) ! (when (setq buf (get-buffer gnus-uu-output-buffer-name)) ! (kill-buffer buf)))) ! ! (defun gnus-quote-arg-for-sh-or-csh (arg) ! (let ((pos 0) new-pos accum) ! ;; *** bug: we don't handle newline characters properly ! (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos)) ! (push (substring arg pos new-pos) accum) ! (push "\\" accum) ! (push (list (aref arg new-pos)) accum) ! (setq pos (1+ new-pos))) ! (if (= pos 0) ! arg ! (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))) ! ! ;; Inputs an action and a filename and returns a full command, making sure ! ;; that the filename will be treated as a single argument when the shell ! ;; executes the command. ! (defun gnus-uu-command (action file) ! (let ((quoted-file (gnus-quote-arg-for-sh-or-csh file))) ! (if (string-match "%s" action) ! (format action quoted-file) ! (concat action " " quoted-file)))) ! ! (defun gnus-uu-delete-work-dir (&optional dir) ! "Delete recursively all files and directories under `gnus-uu-work-dir'." ! (if dir ! (gnus-message 7 "Deleting directory %s..." dir) ! (setq dir gnus-uu-work-dir)) ! (when (and dir ! (file-exists-p dir)) ! (let ((files (directory-files dir t nil t)) ! file) ! (while (setq file (pop files)) ! (unless (member (file-name-nondirectory file) '("." "..")) ! (if (file-directory-p file) ! (gnus-uu-delete-work-dir file) ! (gnus-message 9 "Deleting file %s..." file) ! (delete-file file)))) ! (delete-directory dir))) ! (gnus-message 7 "")) ! ! ;; Initializing ! ! (add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) ! (add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir) ! ! ! ! ;;; ! ;;; uuencoded posting ! ;;; ! ! ;; Any function that is to be used as and encoding method will take two ! ;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" ! ;; and "spiral.jpg", respectively.) The function should return nil if ! ;; the encoding wasn't successful. ! (defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode ! "Function used for encoding binary files. ! There are three functions supplied with gnus-uu for encoding files: ! `gnus-uu-post-encode-uuencode', which does straight uuencoding; ! `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME ! headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with ! uuencode and adds MIME headers." ! :group 'gnus-extract-post ! :type '(radio (function-item gnus-uu-post-encode-uuencode) ! (function-item gnus-uu-post-encode-mime) ! (function-item gnus-uu-post-encode-mime-uuencode) ! (function :tag "Other"))) ! ! (defcustom gnus-uu-post-include-before-composing nil ! "Non-nil means that gnus-uu will ask for a file to encode before you compose the article. ! If this variable is t, you can either include an encoded file with ! \\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article." ! :group 'gnus-extract-post ! :type 'boolean) ! ! (defcustom gnus-uu-post-length 990 ! "Maximum length of an article. ! The encoded file will be split into how many articles it takes to ! post the entire file." ! :group 'gnus-extract-post ! :type 'integer) ! ! (defcustom gnus-uu-post-threaded nil ! "Non-nil means that gnus-uu will post the encoded file in a thread. ! This may not be smart, as no other decoder I have seen are able to ! follow threads when collecting uuencoded articles. (Well, I have seen ! one package that does that - gnus-uu, but somehow, I don't think that ! counts...) The default is nil." ! :group 'gnus-extract-post ! :type 'boolean) ! ! (defcustom gnus-uu-post-separate-description t ! "Non-nil means that the description will be posted in a separate article. ! The first article will typically be numbered (0/x). If this variable ! is nil, the description the user enters will be included at the ! beginning of the first article, which will be numbered (1/x). Default ! is t." ! :group 'gnus-extract-post ! :type 'boolean) ! ! (defvar gnus-uu-post-binary-separator "--binary follows this line--") ! (defvar gnus-uu-post-message-id nil) ! (defvar gnus-uu-post-inserted-file-name nil) ! (defvar gnus-uu-winconf-post-news nil) ! ! (defun gnus-uu-post-news () ! "Compose an article and post an encoded file." ! (interactive) ! (setq gnus-uu-post-inserted-file-name nil) ! (setq gnus-uu-winconf-post-news (current-window-configuration)) ! ! (gnus-summary-post-news) ! ! (use-local-map (copy-keymap (current-local-map))) ! (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) ! (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) ! (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) ! (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) ! ! (when gnus-uu-post-include-before-composing ! (save-excursion (setq gnus-uu-post-inserted-file-name ! (gnus-uu-post-insert-binary))))) ! ! (defun gnus-uu-post-insert-binary-in-article () ! "Inserts an encoded file in the buffer. ! The user will be asked for a file name." ! (interactive) ! (save-excursion ! (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) ! ! ;; Encodes with uuencode and substitutes all spaces with backticks. ! (defun gnus-uu-post-encode-uuencode (path file-name) ! (when (gnus-uu-post-encode-file "uuencode" path file-name) ! (goto-char (point-min)) ! (forward-line 1) ! (while (re-search-forward " " nil t) ! (replace-match "`")) ! t)) ! ! ;; Encodes with uuencode and adds MIME headers. ! (defun gnus-uu-post-encode-mime-uuencode (path file-name) ! (when (gnus-uu-post-encode-uuencode path file-name) ! (gnus-uu-post-make-mime file-name "x-uue") ! t)) ! ! ;; Encodes with base64 and adds MIME headers ! (defun gnus-uu-post-encode-mime (path file-name) ! (when (zerop (call-process shell-file-name nil t nil shell-command-switch ! (format "%s %s -o %s" "mmencode" path file-name))) ! (gnus-uu-post-make-mime file-name "base64") ! t)) ! ! ;; Adds MIME headers. ! (defun gnus-uu-post-make-mime (file-name encoding) ! (goto-char (point-min)) ! (insert (format "Content-Type: %s; name=\"%s\"\n" ! (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) ! file-name)) ! (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) ! (save-restriction ! (set-buffer gnus-message-buffer) ! (goto-char (point-min)) ! (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) ! (forward-line -1) ! (narrow-to-region 1 (point)) ! (unless (mail-fetch-field "mime-version") ! (widen) ! (insert "MIME-Version: 1.0\n")) ! (widen))) ! ! ;; Encodes a file PATH with COMMAND, leaving the result in the ! ;; current buffer. ! (defun gnus-uu-post-encode-file (command path file-name) ! (= 0 (call-process shell-file-name nil t nil shell-command-switch ! (format "%s %s %s" command path file-name)))) ! ! (defun gnus-uu-post-news-inews () ! "Posts the composed news article and encoded file. ! If no file has been included, the user will be asked for a file." ! (interactive) ! ! (let (file-name) ! ! (if gnus-uu-post-inserted-file-name ! (setq file-name gnus-uu-post-inserted-file-name) ! (setq file-name (gnus-uu-post-insert-binary))) ! ! (gnus-uu-post-encoded file-name gnus-uu-post-threaded)) ! (setq gnus-uu-post-inserted-file-name nil) ! (when gnus-uu-winconf-post-news ! (set-window-configuration gnus-uu-winconf-post-news))) ! ! ;; Asks for a file to encode, encodes it and inserts the result in ! ;; the current buffer. Returns the file name the user gave. ! (defun gnus-uu-post-insert-binary () ! (let ((uuencode-buffer-name "*uuencode buffer*") ! file-path uubuf file-name) ! ! (setq file-path (read-file-name ! "What file do you want to encode? ")) ! (when (not (file-exists-p file-path)) ! (error "%s: No such file" file-path)) ! ! (goto-char (point-max)) ! (insert (format "\n%s\n" gnus-uu-post-binary-separator)) ! ! ;; #### Unix-specific? ! (when (string-match "^~/" file-path) ! (setq file-path (concat "$HOME" (substring file-path 1)))) ! ;; #### Unix-specific? ! (if (string-match "/[^/]*$" file-path) ! (setq file-name (substring file-path (1+ (match-beginning 0)))) ! (setq file-name file-path)) ! ! (unwind-protect ! (if (save-excursion ! (set-buffer (setq uubuf ! (gnus-get-buffer-create uuencode-buffer-name))) ! (erase-buffer) ! (funcall gnus-uu-post-encode-method file-path file-name)) ! (insert-buffer-substring uubuf) ! (error "Encoding unsuccessful")) ! (kill-buffer uubuf)) ! file-name)) ! ! ;; 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)) ! ! (save-excursion ! (set-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 1 (point-max))) ! (setq parts (/ length gnus-uu-post-length)) ! (unless (< (% length gnus-uu-post-length) 4) ! (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) ! (beginning-of-line) ! (setq header (buffer-substring 1 (point))) ! ! (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)) ! (save-excursion ! (set-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) ! (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) ! (when (fboundp 'bury-buffer) ! (bury-buffer))))) ! ! (provide 'gnus-uu) ! ! ;; gnus-uu.el ends here --- 1287,1325 ---- (not (memq 'end process-state)) result-file (file-exists-p result-file) ! escription) ! () ! (when (and (not threaded) (re-search-forward "^Subject: " nil t)) ! d1965 3 ! a1967 1 ! (message-send)) ! d1977 1 ! a1977 1 ! (insert (format "References: %s\n" gnus-uu-post-message-id))) ! d1992 3 ! a1994 9 ! (if (not (re-search-forward "^Subject: " nil t)) ! () ! (if (not threaded) ! (progn (end-of-line) ! (insert (format " (%d/%d)" i parts))) ! (when (or (and (= i 2) gnus-uu-post-separate-description) ! (and (= i 1) (not gnus-uu-post-separate-description))) ! (replaemq 'middle process-state))) ! 2007 1 ! a2007 2 (insert beg-line) (insert "\n") ! d2009 1 ! a2009 1 ! (setq i (1+ i)) ! d2023 5 ! a2027 1 ! (message-send)))) ! d2029 2 ! a2030 4 ! (when (setq buf (get-buffer send-buffer-name)) ! (kill-buffer buf)) ! (when (setq buf (get-buffer encoded-buffer-name)) ! (kill-buffer buf)) *** pub/pgnus/lisp/gnus.el Sat Aug 29 19:58:30 1998 --- pgnus/lisp/gnus.el Sat Aug 29 20:01:03 1998 *************** *** 250,259 **** :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "5.6.42" "Version number for this version of Gnus.") ! (defconst gnus-version (format "Gnus v%s" gnus-version-number) "Version string for this version of Gnus.") (defcustom gnus-inhibit-startup-message nil --- 250,259 ---- :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) ! (defconst gnus-version-number "0.1" "Version number for this version of Gnus.") ! (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) "Version string for this version of Gnus.") (defcustom gnus-inhibit-startup-message nil *************** *** 2005,2011 **** ((member alpha '("September" "s")) "5.01") ((member alpha '("Red" "r")) "5.03") ((member alpha '("Quassia" "q")) "5.05") ! ((member alpha '("p")) "5.07") ((member alpha '("o")) "5.09") ((member alpha '("n")) "5.11")) minor least) --- 2005,2011 ---- ((member alpha '("September" "s")) "5.01") ((member alpha '("Red" "r")) "5.03") ((member alpha '("Quassia" "q")) "5.05") ! ((member alpha '("Pterodactyl" "p")) "5.07") ((member alpha '("o")) "5.09") ((member alpha '("n")) "5.11")) minor least) *** pub/pgnus/lisp/ChangeLog Sat Aug 29 19:58:24 1998 --- pgnus/lisp/ChangeLog Sat Aug 29 20:01:02 1998 *************** *** 1,3 **** --- 1,7 ---- + Sat Aug 29 19:32:06 1998 Lars Magne Ingebrigtsen + + * gnus.el: Gnus v0.2 is released. + Sat Aug 29 19:17:19 1998 Lars Magne Ingebrigtsen * gnus.el: Gnus v5.6.42 is released. *** pub/pgnus/texi/gnus.texi Sat Aug 29 19:58:43 1998 --- pgnus/texi/gnus.texi Sat Aug 29 20:01:04 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Gnus 5.6.42 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename gnus ! @settitle Pterodactyl Gnus 0.2 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 318,324 **** @tex @titlepage ! @title Gnus 5.6.42 Manual @author by Lars Magne Ingebrigtsen @page --- 318,324 ---- @tex @titlepage ! @title Pterodactyl Gnus 0.2 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 354,360 **** spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Gnus 5.6.42. @end ifinfo --- 354,360 ---- spool or your mbox file. All at the same time, if you want to push your luck. ! This manual corresponds to Pterodactyl Gnus 0.2. @end ifinfo *** pub/pgnus/texi/message.texi Sat Aug 29 19:58:43 1998 --- pgnus/texi/message.texi Sat Aug 29 20:01:04 1998 *************** *** 1,7 **** \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Message 5.6.42 Manual @synindex fn cp @synindex vr cp @synindex pg cp --- 1,7 ---- \input texinfo @c -*-texinfo-*- @setfilename message ! @settitle Pterodactyl Message 0.2 Manual @synindex fn cp @synindex vr cp @synindex pg cp *************** *** 42,48 **** @tex @titlepage ! @title Message 5.6.42 Manual @author by Lars Magne Ingebrigtsen @page --- 42,48 ---- @tex @titlepage ! @title Pterodactyl Message 0.2 Manual @author by Lars Magne Ingebrigtsen @page *************** *** 83,91 **** * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Message 5.6.42. Message is distributed with ! the Gnus distribution bearing the same version number as this manual ! has. @node Interface --- 83,91 ---- * Key Index:: List of Message mode keys. @end menu ! This manual corresponds to Pterodactyl Message 0.2. Message is ! distributed with the Gnus distribution bearing the same version number ! as this manual has. @node Interface