;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Created: 2 Oct 1993
-;; Version: v3.0
;; Keyword: news
;; This file is part of GNU Emacs.
(defvar gnus-uu-file-name nil)
(defconst gnus-uu-uudecode-process nil)
+(defvar gnus-uu-binhex-article-name nil)
(defvar gnus-uu-generated-file-list nil)
(defvar gnus-uu-work-dir nil)
(defconst gnus-uu-output-buffer-name " *Gnus UU Output*")
-(defconst gnus-uu-highest-article-number 1)
(defvar gnus-uu-default-dir default-directory)
+(defvar gnus-uu-digest-from-subject nil)
;; Keymaps
(defvar gnus-uu-mark-map nil)
(define-prefix-command 'gnus-uu-mark-map)
-(define-key gnus-summary-mark-map "p" 'gnus-uu-mark-map)
+(define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map)
(define-key gnus-uu-mark-map "p" 'gnus-summary-mark-as-processable)
(define-key gnus-uu-mark-map "u" 'gnus-summary-unmark-as-processable)
(define-key gnus-uu-mark-map "U" 'gnus-summary-unmark-all-processable)
(define-key gnus-uu-mark-map "r" 'gnus-uu-mark-region)
(define-key gnus-uu-mark-map "R" 'gnus-uu-mark-by-regexp)
(define-key gnus-uu-mark-map "t" 'gnus-uu-mark-thread)
+(define-key gnus-uu-mark-map "T" 'gnus-uu-unmark-thread)
(define-key gnus-uu-mark-map "a" 'gnus-uu-mark-all)
+(define-key gnus-uu-mark-map "b" 'gnus-uu-mark-buffer)
(define-key gnus-uu-mark-map "S" 'gnus-uu-mark-sparse)
(define-prefix-command 'gnus-uu-extract-map)
(file-name-as-directory
(read-file-name "Unbinhex and save in dir: "
gnus-uu-default-dir
- gnus-uu-default-dir t))))
+ gnus-uu-default-dir))))
+ (setq gnus-uu-binhex-article-name
+ (make-temp-name (concat gnus-uu-work-dir "binhex")))
(gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
(defun gnus-uu-decode-uu-view (n)
(list current-prefix-arg
(read-file-name "Unbinhex, view and save in dir: "
gnus-uu-default-dir gnus-uu-default-dir)))
+ (setq gnus-uu-binhex-article-name
+ (make-temp-name (concat gnus-uu-work-dir "binhex")))
(let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
(gnus-uu-decode-binhex n file)))
(interactive "P")
(let ((gnus-uu-save-in-digest t)
(file (make-temp-name (concat gnus-uu-tmp-dir "forward")))
- buf)
+ buf subject from)
+ (setq gnus-uu-digest-from-subject nil)
(gnus-uu-decode-save n file)
(gnus-uu-add-file file)
(setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*")))
(erase-buffer)
(delete-other-windows)
(insert-file file)
+ (let ((fs gnus-uu-digest-from-subject))
+ (if (not fs)
+ ()
+ (setq from (car (car fs))
+ subject (gnus-simplify-subject-fuzzy (cdr (car fs)))
+ fs (cdr fs))
+ (while (and fs (or from subject))
+ (and from
+ (or (string= from (car (car fs)))
+ (setq from nil)))
+ (and subject
+ (or (string= (gnus-simplify-subject-fuzzy (cdr (car fs)))
+ subject)
+ (setq subject nil)))
+ (setq fs (cdr fs))))
+ (or subject (setq subject "Digested Articles"))
+ (or from (setq from "Various")))
(goto-char (point-min))
(and (re-search-forward "^Subject: ")
(progn
(delete-region (point) (gnus-point-at-eol))
- (insert "Digested Articles")))
+ (insert subject)))
(goto-char (point-min))
(and (re-search-forward "^From: ")
(progn
(delete-region (point) (gnus-point-at-eol))
- (insert "Various")))
+ (insert from)))
(if post
(gnus-forward-using-post)
- (funcall gnus-mail-forward-method))
+ (gnus-mail-forward))
(delete-file file)
- (kill-buffer buf)))
+ (kill-buffer buf)
+ (setq gnus-uu-digest-from-subject nil)))
(defun gnus-uu-digest-post-forward (n)
"Digest and forward to a newsgroup."
(gnus-summary-set-process-mark (car articles))
(setq articles (cdr articles)))
(message ""))
- (gnus-summary-position-cursor))
+ (gnus-summary-position-point))
(defun gnus-uu-mark-series ()
"Mark the current series with the process mark."
(gnus-summary-set-process-mark (car articles))
(setq articles (cdr articles)))
(message ""))
- (gnus-summary-position-cursor))
+ (gnus-summary-position-point))
(defun gnus-uu-mark-region (beg end)
- "Marks all articles between point and mark."
+ "Set the process mark on all articles between point and mark."
(interactive "r")
(gnus-set-global-variables)
(save-excursion
(while (< (point) end)
(gnus-summary-set-process-mark (gnus-summary-article-number))
(forward-line 1)))
- (gnus-summary-position-cursor))
+ (gnus-summary-position-point))
+
+(defun gnus-uu-mark-buffer ()
+ "Set the process mark on all articles in the buffer."
+ (interactive)
+ (gnus-uu-mark-region (point-min) (point-max)))
(defun gnus-uu-mark-thread ()
"Marks all articles downwards in this thread."
(interactive)
(gnus-set-global-variables)
- (save-excursion
- (let ((level (gnus-summary-thread-level)))
+ (let ((level (gnus-summary-thread-level)))
(while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
(zerop (gnus-summary-next-subject 1))
- (> (gnus-summary-thread-level) level)))))
- (gnus-summary-position-cursor))
+ (> (gnus-summary-thread-level) level))))
+ (gnus-summary-position-point))
+
+(defun gnus-uu-unmark-thread ()
+ "Unmarks all articles downwards in this thread."
+ (interactive)
+ (gnus-set-global-variables)
+ (let ((level (gnus-summary-thread-level)))
+ (while (and (gnus-summary-remove-process-mark
+ (gnus-summary-article-number))
+ (zerop (gnus-summary-next-subject 1))
+ (> (gnus-summary-thread-level) level))))
+ (gnus-summary-position-point))
(defun gnus-uu-mark-sparse ()
"Mark all series that have some articles marked."
(setq gnus-newsgroup-processable nil)
(save-excursion
(while marked
- (and (setq headers (gnus-get-header-by-number (car marked)))
- (setq subject (header-subject headers)
+ (and (setq headers (gnus-summary-article-header (car marked)))
+ (setq subject (mail-header-subject headers)
articles (gnus-uu-find-articles-matching
(gnus-uu-reginize-string subject))
total (nconc total articles)))
(setq articles (cdr articles)))
(setq marked (cdr marked)))
(setq gnus-newsgroup-processable (nreverse total)))
- (gnus-summary-position-cursor)))
+ (gnus-summary-position-point)))
(defun gnus-uu-mark-all ()
"Mark all articles in \"series\" order."
(if (not (memq number gnus-newsgroup-processable))
(save-excursion (gnus-uu-mark-series)))
(forward-line 1))))
- (gnus-summary-position-cursor))
+ (gnus-summary-position-point))
;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
;; Internal functions.
(defun gnus-uu-decode-with-method (method n &optional save not-insert scan)
- (gnus-uu-initialize)
+ (gnus-uu-initialize scan)
(if save (setq gnus-uu-default-dir save))
(let ((articles (gnus-uu-get-list-of-articles n))
files)
(let ((len (length files))
to-file file)
(while files
- (setq file (cdr (assq 'name (car files))))
- (and (file-exists-p file)
- (progn
- (setq to-file (if (file-directory-p dir)
- (concat dir (file-name-nondirectory file))
- dir))
- (and (or (not (file-exists-p to-file))
- (gnus-y-or-n-p (format "%s exists; overwrite? "
- to-file)))
- (copy-file file to-file 1 t))))
+ (and
+ (setq file (cdr (assq 'name (car files))))
+ (file-exists-p file)
+ (progn
+ (setq to-file (if (file-directory-p dir)
+ (concat dir (file-name-nondirectory file))
+ dir))
+ (and (or (not (file-exists-p to-file))
+ (gnus-y-or-n-p (format "%s exists; overwrite? "
+ to-file)))
+ (copy-file file to-file t t))))
(setq files (cdr files)))
(message "Saved %d file%s" len (if (> len 1) "s" ""))))
'begin 'end))
((eq in-state 'last) (list 'end))
(t (list 'middle)))))
- (t
- (let ((name (file-name-nondirectory gnus-uu-saved-article-name))
- beg subj headers headline sorthead body end-string state)
- (if (or (eq in-state 'first)
- (eq in-state 'first-and-last))
- (progn
- (setq state (list 'begin))
- (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
- (erase-buffer))
- (save-excursion
- (set-buffer (get-buffer-create "*gnus-uu-pre*"))
- (erase-buffer)
- (insert (format
- "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n"
- (current-time-string) name name))))
- (if (not (eq in-state 'end))
- (setq state (list 'middle))))
- (save-excursion
- (set-buffer (get-buffer "*gnus-uu-body*"))
- (goto-char (setq beg (point-max)))
- (save-excursion
- (save-restriction
- (set-buffer buffer)
- (goto-char (point-min))
- (re-search-forward "\n\n")
- (setq body (buffer-substring (1- (point)) (point-max)))
- (narrow-to-region 1 (point))
- (setq headers gnus-uu-digest-headers)
- (while headers
- (setq headline (car headers))
- (setq headers (cdr headers))
- (goto-char (point-min))
- (if (re-search-forward headline nil t)
- (setq sorthead
- (concat sorthead
- (buffer-substring
- (match-beginning 0)
- (or (and (re-search-forward "^[^ \t]" nil t)
- (1- (point)))
- (progn (forward-line 1) (point))))))))
- (widen)))
- (insert sorthead)(goto-char (point-max))
- (insert body)(goto-char (point-max))
- (insert (concat "\n" (make-string 30 ?-) "\n\n"))
- (goto-char beg)
- (if (re-search-forward "^Subject: \\(.*\\)$" nil t)
- (progn
- (setq subj (buffer-substring (match-beginning 1) (match-end 1)))
- (save-excursion
+ (t
+ (let ((header (gnus-summary-article-header)))
+ (setq gnus-uu-digest-from-subject
+ (cons (cons (mail-header-from header)
+ (mail-header-subject header))
+ gnus-uu-digest-from-subject)))
+ (let ((name (file-name-nondirectory gnus-uu-saved-article-name))
+ beg subj headers headline sorthead body end-string state)
+ (if (or (eq in-state 'first)
+ (eq in-state 'first-and-last))
+ (progn
+ (setq state (list 'begin))
+ (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
+ (erase-buffer))
+ (save-excursion
+ (set-buffer (get-buffer-create "*gnus-uu-pre*"))
+ (erase-buffer)
+ (insert (format
+ "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n"
+ (current-time-string) name name))))
+ (if (not (eq in-state 'end))
+ (setq state (list 'middle))))
+ (save-excursion
+ (set-buffer (get-buffer "*gnus-uu-body*"))
+ (goto-char (setq beg (point-max)))
+ (save-excursion
+ (save-restriction
+ (set-buffer buffer)
+ (let (buffer-read-only)
+ (set-text-properties (point-min) (point-max) nil)
+ ;; These two are necessary for XEmacs 19.12 fascism.
+ (put-text-property (point-min) (point-max) 'invisible nil)
+ (put-text-property (point-min) (point-max) 'intangible nil))
+ (goto-char (point-min))
+ (re-search-forward "\n\n")
+ (setq body (buffer-substring (1- (point)) (point-max)))
+ (narrow-to-region 1 (point))
+ (if (not (setq headers gnus-uu-digest-headers))
+ (setq sorthead (buffer-substring (point-min) (point-max)))
+ (while headers
+ (setq headline (car headers))
+ (setq headers (cdr headers))
+ (goto-char (point-min))
+ (if (re-search-forward headline nil t)
+ (setq sorthead
+ (concat sorthead
+ (buffer-substring
+ (match-beginning 0)
+ (or (and (re-search-forward "^[^ \t]" nil t)
+ (1- (point)))
+ (progn (forward-line 1) (point)))))))))
+ (widen)))
+ (insert sorthead) (goto-char (point-max))
+ (insert body) (goto-char (point-max))
+ (insert (concat "\n" (make-string 30 ?-) "\n\n"))
+ (goto-char beg)
+ (if (re-search-forward "^Subject: \\(.*\\)$" nil t)
+ (progn
+ (setq subj (buffer-substring (match-beginning 1) (match-end 1)))
+ (save-excursion
(set-buffer (get-buffer "*gnus-uu-pre*"))
(insert (format " %s\n" subj))))))
(if (or (eq in-state 'last)
"^:...............................................................$")
(defconst gnus-uu-binhex-end-line
":$")
-(defvar gnus-uu-binhex-article-name nil)
(defun gnus-uu-binhex-article (buffer in-state)
(let (state start-char)
(let ((state (list 'ok))
start-char end-char file-name)
(save-excursion
- (set-buffer process-buffer)
- (goto-char (point-min))
- (if (not (re-search-forward gnus-uu-postscript-begin-string nil t))
- (setq state (list 'wrong-type))
- (beginning-of-line)
- (setq start-char (point))
- (if (not (re-search-forward gnus-uu-postscript-end-string nil t))
- (setq state (list 'wrong-type))
- (setq end-char (point))
- (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
- (insert-buffer-substring process-buffer start-char end-char)
- (setq file-name (concat gnus-uu-work-dir (cdr gnus-article-current) ".ps"))
- (write-region (point-min) (point-max) file-name)
- (setq state (list file-name'begin 'end))
-
- ))
- )
+ (set-buffer process-buffer)
+ (goto-char (point-min))
+ (if (not (re-search-forward gnus-uu-postscript-begin-string nil t))
+ (setq state (list 'wrong-type))
+ (beginning-of-line)
+ (setq start-char (point))
+ (if (not (re-search-forward gnus-uu-postscript-end-string nil t))
+ (setq state (list 'wrong-type))
+ (setq end-char (point))
+ (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
+ (insert-buffer-substring process-buffer start-char end-char)
+ (setq file-name (concat gnus-uu-work-dir (cdr gnus-article-current) ".ps"))
+ (write-region (point-min) (point-max) file-name)
+ (setq state (list file-name'begin 'end))
+
+ ))
+ )
state))
;; Failing that, articles that have subjects that are part of the
;; same "series" as the current will be returned.
(let (articles)
- (cond
- (n
- (let ((backward (< n 0))
- (n (abs n)))
- (save-excursion
- (while (and (> n 0)
- (setq articles (cons (gnus-summary-article-number)
- articles))
- (gnus-summary-search-forward nil nil backward))
- (setq n (1- n))))
- (nreverse articles)))
- (gnus-newsgroup-processable
- (reverse gnus-newsgroup-processable))
- (t
- (gnus-uu-find-articles-matching)))))
+ (cond
+ (n
+ (let ((backward (< n 0))
+ (n (abs n)))
+ (save-excursion
+ (while (and (> n 0)
+ (setq articles (cons (gnus-summary-article-number)
+ articles))
+ (gnus-summary-search-forward nil nil backward))
+ (setq n (1- n))))
+ (nreverse articles)))
+ (gnus-newsgroup-processable
+ (reverse gnus-newsgroup-processable))
+ (t
+ (gnus-uu-find-articles-matching)))))
(defun gnus-uu-string< (l1 l2)
(string< (car l1) (car l2)))
;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is
;; non-nil, article names are not equalized before sorting.
(let ((subject (or subject
- (gnus-uu-reginize-string (gnus-summary-subject-string))))
+ (gnus-uu-reginize-string (gnus-summary-article-subject))))
list-of-subjects)
(save-excursion
(if (not subject)
subj mark)
(goto-char (point-min))
(while (not (eobp))
- (and (setq subj (gnus-summary-subject-string))
+ (and (setq subj (gnus-summary-article-subject))
(string-match subject subj)
(or (not only-unread)
(= (setq mark (gnus-summary-article-mark))
(setq articles (cdr articles))
(setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed))
- (if (> article gnus-uu-highest-article-number)
- (setq gnus-uu-highest-article-number article))
-
(if (eq articles ())
(if (eq state 'first)
(setq state 'first-and-last)
(message "Getting article %d, %s" article (gnus-uu-part-number article))
(if (not (= (or gnus-current-article 0) article))
- (progn
+ (let ((nntp-async-number nil))
(gnus-request-article article gnus-newsgroup-name
nntp-server-buffer)
(setq gnus-last-article gnus-current-article)
(if (stringp nntp-server-buffer)
(setq article-buffer nntp-server-buffer)
(setq article-buffer (buffer-name nntp-server-buffer))))
+ (gnus-summary-stop-page-breaking)
(setq article-buffer gnus-article-buffer))
(buffer-disable-undo article-buffer)
;; Mark article as read.
- (run-hooks 'gnus-mark-article-hook)
(and (memq article gnus-newsgroup-processable)
(gnus-summary-remove-process-mark article))
+ (run-hooks 'gnus-mark-article-hook)
(setq process-state (funcall process-function article-buffer state))
(if (and (or (eq state 'last) (eq state 'first-and-last))
(not (memq 'end process-state)))
- (if (and result-file (file-exists-p result-file))
- (delete-file result-file)))
+ (if (and result-file (file-exists-p result-file))
+ (delete-file result-file)))
(if (not (memq 'wrong-type process-state))
()
(widen)
(erase-buffer)
(insert-buffer-substring article-buffer)
+ (gnus-set-mode-line 'article)
(goto-char (point-min)))))
+ (gnus-set-mode-line 'summary)
+
(if result-files
()
(if (not has-been-begin)
result-files))
(defun gnus-uu-part-number (article)
- (let ((subject (header-subject (gnus-get-header-by-number article))))
+ (let ((subject (mail-header-subject (gnus-summary-article-header article))))
(if (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+"
subject)
(substring subject (match-beginning 0) (match-end 0))
(or (looking-at gnus-uu-body-line)
(gnus-delete-line))
- ; Replace any slashes and spaces in file names before decoding
+ ; Replace any slashes and spaces in file names before decoding
(goto-char name-beg)
(while (re-search-forward "/" name-end t)
(replace-match ","))
(replace-match "_"))
(goto-char name-beg)
(if (re-search-forward "_*$" name-end t)
- (replace-match ""))
+ (replace-match ""))
(setq gnus-uu-file-name (buffer-substring name-beg name-end))
(and gnus-uu-uudecode-process
(progn
(delete-process gnus-uu-uudecode-process)
(message "gnus-uu: Couldn't uudecode")
-; (sleep-for 2)
+ ; (sleep-for 2)
(setq state (list 'wrong-type)))))
(if (memq 'end 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) "sh" nil
- (get-buffer-create gnus-uu-output-buffer-name) nil
- "-c" (concat "cd " gnus-uu-work-dir " ; sh"))))
+ (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) "sh" nil
+ (get-buffer-create gnus-uu-output-buffer-name) nil
+ "-c" (concat "cd " gnus-uu-work-dir " ; sh"))))
state))
;; Returns the name of what the shar file is going to unpack.
;; 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
(or no-ignore
(defvar gnus-uu-tmp-alist nil)
-(defun gnus-uu-initialize ()
+(defun gnus-uu-initialize (&optional scan)
(let (entry)
- (if (if (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))
+ (if (and (not scan)
+ (if (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-highest-article-number 1)
(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))
beginning of the first article, which will be numbered (1/x). Default
is t.")
-(defconst gnus-uu-post-binary-separator "--binary follows this line--")
+(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)
(get-buffer-create uuencode-buffer-name)))
(erase-buffer)
(funcall gnus-uu-post-encode-method file-path file-name))
- (insert-buffer uubuf)
+ (insert-buffer-substring uubuf)
(error "Encoding unsuccessful"))
(kill-buffer uubuf))
file-name))
projects / gnus / blobdiff