[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-uu.el
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/gnus-uu.el |
Date: |
Sat, 04 Sep 2004 09:48:58 -0400 |
Index: emacs/lisp/gnus/gnus-uu.el
diff -c emacs/lisp/gnus/gnus-uu.el:1.16 emacs/lisp/gnus/gnus-uu.el:1.17
*** emacs/lisp/gnus/gnus-uu.el:1.16 Mon Sep 1 15:45:24 2003
--- emacs/lisp/gnus/gnus-uu.el Sat Sep 4 13:13:43 2004
***************
*** 1,6 ****
;;; gnus-uu.el --- extract (uu)encoded files in Gnus
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
! ;; 2001 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <address@hidden>
;; Created: 2 Oct 1993
--- 1,6 ----
;;; gnus-uu.el --- extract (uu)encoded files in Gnus
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 2000,
! ;; 2001, 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <address@hidden>
;; Created: 2 Oct 1993
***************
*** 299,305 ****
"^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
"^Content-ID:")
"*List of regexps to match headers included in digested messages.
! The headers will be included in the sequence they are matched."
:group 'gnus-extract
:type '(repeat regexp))
--- 299,306 ----
"^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
"^Content-ID:")
"*List of regexps to match headers included in digested messages.
! The headers will be included in the sequence they are matched. If nil
! include all headers."
:group 'gnus-extract
:type '(repeat regexp))
***************
*** 321,327 ****
(defvar gnus-uu-saved-article-name nil)
! (defvar gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
(defvar gnus-uu-end-string "^end[ \t]*$")
(defvar gnus-uu-body-line "^M")
--- 322,328 ----
(defvar gnus-uu-saved-article-name nil)
! (defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$")
(defvar gnus-uu-end-string "^end[ \t]*$")
(defvar gnus-uu-body-line "^M")
***************
*** 336,342 ****
(defvar gnus-uu-shar-file-name nil)
(defvar gnus-uu-shar-name-marker
! "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
(defvar gnus-uu-postscript-begin-string "^%!PS-")
(defvar gnus-uu-postscript-end-string "^%%EOF$")
--- 337,343 ----
(defvar gnus-uu-shar-file-name nil)
(defvar gnus-uu-shar-name-marker
! "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)")
(defvar gnus-uu-postscript-begin-string "^%!PS-")
(defvar gnus-uu-postscript-end-string "^%%EOF$")
***************
*** 353,408 ****
(defvar gnus-uu-digest-from-subject nil)
(defvar gnus-uu-digest-buffer nil)
- ;; Keymaps
-
- (gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
- "p" gnus-summary-mark-as-processable
- "u" gnus-summary-unmark-as-processable
- "U" gnus-summary-unmark-all-processable
- "v" gnus-uu-mark-over
- "s" gnus-uu-mark-series
- "r" gnus-uu-mark-region
- "g" gnus-uu-unmark-region
- "R" gnus-uu-mark-by-regexp
- "G" gnus-uu-unmark-by-regexp
- "t" gnus-uu-mark-thread
- "T" gnus-uu-unmark-thread
- "a" gnus-uu-mark-all
- "b" gnus-uu-mark-buffer
- "S" gnus-uu-mark-sparse
- "k" gnus-summary-kill-process-mark
- "y" gnus-summary-yank-process-mark
- "w" gnus-summary-save-process-mark
- "i" gnus-uu-invert-processable)
-
- (gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
- ;;"x" gnus-uu-extract-any
- "m" gnus-summary-save-parts
- "u" gnus-uu-decode-uu
- "U" gnus-uu-decode-uu-and-save
- "s" gnus-uu-decode-unshar
- "S" gnus-uu-decode-unshar-and-save
- "o" gnus-uu-decode-save
- "O" gnus-uu-decode-save
- "b" gnus-uu-decode-binhex
- "B" gnus-uu-decode-binhex
- "p" gnus-uu-decode-postscript
- "P" gnus-uu-decode-postscript-and-save)
-
- (gnus-define-keys
- (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
- "u" gnus-uu-decode-uu-view
- "U" gnus-uu-decode-uu-and-save-view
- "s" gnus-uu-decode-unshar-view
- "S" gnus-uu-decode-unshar-and-save-view
- "o" gnus-uu-decode-save-view
- "O" gnus-uu-decode-save-view
- "b" gnus-uu-decode-binhex-view
- "B" gnus-uu-decode-binhex-view
- "p" gnus-uu-decode-postscript-view
- "P" gnus-uu-decode-postscript-and-save-view)
-
-
;; Commands.
(defun gnus-uu-decode-uu (&optional n)
--- 354,359 ----
***************
*** 529,571 ****
(if (and n (not (numberp n)))
(setq message-forward-as-mime (not message-forward-as-mime)
n nil))
! (gnus-setup-message 'forward
! (setq gnus-uu-digest-from-subject nil)
! (setq gnus-uu-digest-buffer
! (gnus-get-buffer-create " *gnus-uu-forward*"))
! (gnus-uu-decode-save n file)
! (switch-to-buffer gnus-uu-digest-buffer)
! (let ((fs gnus-uu-digest-from-subject))
! (when fs
! (setq from (caar fs)
! subject (gnus-simplify-subject-fuzzy (cdar fs))
! fs (cdr fs))
! (while (and fs (or from subject))
! (when from
! (unless (string= from (caar fs))
! (setq from nil)))
! (when subject
! (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
! subject)
! (setq subject nil)))
! (setq fs (cdr fs))))
! (unless subject
! (setq subject "Digested Articles"))
! (unless from
! (setq from
! (if (gnus-news-group-p gnus-newsgroup-name)
! gnus-newsgroup-name
! "Various"))))
! (goto-char (point-min))
! (when (re-search-forward "^Subject: ")
! (delete-region (point) (gnus-point-at-eol))
! (insert subject))
! (goto-char (point-min))
! (when (re-search-forward "^From:")
! (delete-region (point) (gnus-point-at-eol))
! (insert " " from))
! (let ((message-forward-decoded-p t))
! (message-forward post t)))
(setq gnus-uu-digest-from-subject nil)))
(defun gnus-uu-digest-post-forward (&optional n)
--- 480,523 ----
(if (and n (not (numberp n)))
(setq message-forward-as-mime (not message-forward-as-mime)
n nil))
! (let ((gnus-article-reply (gnus-summary-work-articles n)))
! (gnus-setup-message 'forward
! (setq gnus-uu-digest-from-subject nil)
! (setq gnus-uu-digest-buffer
! (gnus-get-buffer-create " *gnus-uu-forward*"))
! (gnus-uu-decode-save n file)
! (switch-to-buffer gnus-uu-digest-buffer)
! (let ((fs gnus-uu-digest-from-subject))
! (when fs
! (setq from (caar fs)
! subject (gnus-simplify-subject-fuzzy (cdar fs))
! fs (cdr fs))
! (while (and fs (or from subject))
! (when from
! (unless (string= from (caar fs))
! (setq from nil)))
! (when subject
! (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
! subject)
! (setq subject nil)))
! (setq fs (cdr fs))))
! (unless subject
! (setq subject "Digested Articles"))
! (unless from
! (setq from
! (if (gnus-news-group-p gnus-newsgroup-name)
! gnus-newsgroup-name
! "Various"))))
! (goto-char (point-min))
! (when (re-search-forward "^Subject: ")
! (delete-region (point) (gnus-point-at-eol))
! (insert subject))
! (goto-char (point-min))
! (when (re-search-forward "^From:")
! (delete-region (point) (gnus-point-at-eol))
! (insert " " from))
! (let ((message-forward-decoded-p t))
! (message-forward post t))))
(setq gnus-uu-digest-from-subject nil)))
(defun gnus-uu-digest-post-forward (&optional n)
***************
*** 575,591 ****
;; Process marking.
(defun gnus-uu-mark-by-regexp (regexp &optional unmark)
"Set the process mark on articles whose subjects match REGEXP.
When called interactively, prompt for REGEXP.
Optional UNMARK non-nil means unmark instead of mark."
(interactive "sMark (regexp): \nP")
! (let ((articles (gnus-uu-find-articles-matching regexp)))
! (while articles
! (if unmark
! (gnus-summary-remove-process-mark (pop articles))
! (gnus-summary-set-process-mark (pop articles))))
! (message ""))
(gnus-summary-position-point))
(defun gnus-uu-unmark-by-regexp (regexp)
--- 527,566 ----
;; Process marking.
+ (defun gnus-message-process-mark (unmarkp new-marked)
+ (let ((old (- (length gnus-newsgroup-processable) (length new-marked))))
+ (message "%d mark%s %s%s"
+ (length new-marked)
+ (if (= (length new-marked) 1) "" "s")
+ (if unmarkp "removed" "added")
+ (cond
+ ((and (zerop old)
+ (not unmarkp))
+ "")
+ (unmarkp
+ (format ", %d remain marked"
+ (length gnus-newsgroup-processable)))
+ (t
+ (format ", %d already marked" old))))))
+
+ (defun gnus-new-processable (unmarkp articles)
+ (if unmarkp
+ (gnus-intersection gnus-newsgroup-processable articles)
+ (gnus-set-difference articles gnus-newsgroup-processable)))
+
(defun gnus-uu-mark-by-regexp (regexp &optional unmark)
"Set the process mark on articles whose subjects match REGEXP.
When called interactively, prompt for REGEXP.
Optional UNMARK non-nil means unmark instead of mark."
(interactive "sMark (regexp): \nP")
! (save-excursion
! (let* ((articles (gnus-uu-find-articles-matching regexp))
! (new-marked (gnus-new-processable unmark articles)))
! (while articles
! (if unmark
! (gnus-summary-remove-process-mark (pop articles))
! (gnus-summary-set-process-mark (pop articles))))
! (gnus-message-process-mark unmark new-marked)))
(gnus-summary-position-point))
(defun gnus-uu-unmark-by-regexp (regexp)
***************
*** 597,607 ****
(defun gnus-uu-mark-series ()
"Mark the current series with the process mark."
(interactive)
! (let ((articles (gnus-uu-find-articles-matching)))
(while articles
(gnus-summary-set-process-mark (car articles))
(setq articles (cdr articles)))
! (message ""))
(gnus-summary-position-point))
(defun gnus-uu-mark-region (beg end &optional unmark)
--- 572,583 ----
(defun gnus-uu-mark-series ()
"Mark the current series with the process mark."
(interactive)
! (let* ((articles (gnus-uu-find-articles-matching))
! (l (length articles)))
(while articles
(gnus-summary-set-process-mark (car articles))
(setq articles (cdr articles)))
! (message "Marked %d articles" l))
(gnus-summary-position-point))
(defun gnus-uu-mark-region (beg end &optional unmark)
***************
*** 862,870 ****
"Date: %s\nFrom: %s\nSubject: %s Digest\n\n"
(current-time-string) name name))
(when (and message-forward-as-mime gnus-uu-digest-buffer)
! ;; The default part in multipart/digest is message/rfc822.
! ;; Subject is a fake head.
! (insert "<#part type=text/plain>\nSubject: Topics\n\n"))
(insert "Topics:\n")))
(when (not (eq in-state 'end))
(setq state (list 'middle))))
--- 838,844 ----
"Date: %s\nFrom: %s\nSubject: %s Digest\n\n"
(current-time-string) name name))
(when (and message-forward-as-mime gnus-uu-digest-buffer)
! (insert "<#part type=message/rfc822>\nSubject: Topics\n\n"))
(insert "Topics:\n")))
(when (not (eq in-state 'end))
(setq state (list 'middle))))
***************
*** 896,902 ****
(setq body (buffer-substring (1- (point)) (point-max)))
(narrow-to-region (point-min) (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))
--- 870,876 ----
(setq body (buffer-substring (1- (point)) (point-max)))
(narrow-to-region (point-min) (point))
(if (not (setq headers gnus-uu-digest-headers))
! (setq sorthead (buffer-string))
(while headers
(setq headline (car headers))
(setq headers (cdr headers))
***************
*** 1116,1122 ****
(while (re-search-forward "[ \t]+" nil t)
(replace-match "[ \t]+" t t))
! (buffer-substring (point-min) (point-max))))
(defun gnus-uu-get-list-of-articles (n)
;; If N is non-nil, the article numbers of the N next articles
--- 1090,1096 ----
(while (re-search-forward "[ \t]+" nil t)
(replace-match "[ \t]+" t t))
! (buffer-string)))
(defun gnus-uu-get-list-of-articles (n)
;; If N is non-nil, the article numbers of the N next articles
***************
*** 1208,1218 ****
;; Expand numbers.
(goto-char (point-min))
(while (re-search-forward "[0-9]+" nil t)
! (replace-match
! (format "%06d"
! (string-to-int (buffer-substring
! (match-beginning 0) (match-end 0))))))
! (setq string (buffer-substring (point-min) (point-max)))
(setcar (car string-list) string)
(setq string-list (cdr string-list))))
out-list))
--- 1182,1193 ----
;; Expand numbers.
(goto-char (point-min))
(while (re-search-forward "[0-9]+" nil t)
! (ignore-errors
! (replace-match
! (format "%06d"
! (string-to-int (buffer-substring
! (match-beginning 0) (match-end 0)))))))
! (setq string (buffer-substring 1 (point-max)))
(setcar (car string-list) string)
(setq string-list (cdr string-list))))
out-list))
***************
*** 1377,1403 ****
(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)))))
;; The original article buffer is hosed, shoot it down.
(gnus-kill-buffer gnus-original-article-buffer)
!
result-files))
(defun gnus-uu-grab-view (file)
--- 1352,1378 ----
(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))))
;; The original article buffer is hosed, shoot it down.
(gnus-kill-buffer gnus-original-article-buffer)
! (setq gnus-current-article nil)
result-files))
(defun gnus-uu-grab-view (file)
***************
*** 1463,1472 ****
;; 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)
--- 1438,1447 ----
;; This is the beginning of a uuencoded article.
;; We replace certain characters that could make things messy.
(setq gnus-uu-file-name
! (gnus-map-function
! mm-file-name-rewrite-functions
! (file-name-nondirectory (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)
***************
*** 1655,1661 ****
(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 "")
--- 1630,1636 ----
(gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
! (if (eq 0 (call-process shell-file-name nil
(gnus-get-buffer-create gnus-uu-output-buffer-name)
nil shell-command-switch command))
(message "")
***************
*** 1820,1828 ****
(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
--- 1795,1807 ----
(if (file-directory-p file)
(gnus-uu-delete-work-dir file)
(gnus-message 9 "Deleting file %s..." file)
! (condition-case err
! (delete-file file)
! (error (gnus-message 3 "Deleting file %s failed... %s" file
err))))))
! (condition-case err
! (delete-directory dir)
! (error (gnus-message 3 "Deleting directory %s failed... %s" file
err))))
! (gnus-message 7 "")))
;; Initializing
***************
*** 1900,1906 ****
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
(use-local-map 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)
--- 1879,1885 ----
(let ((map (make-sparse-keymap)))
(set-keymap-parent map (current-local-map))
(use-local-map 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)
***************
*** 1933,1940 ****
;; 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))
--- 1912,1919 ----
;; Encodes with base64 and adds MIME headers
(defun gnus-uu-post-encode-mime (path file-name)
! (when (eq 0 (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))
***************
*** 1959,1966 ****
;; 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.
--- 1938,1945 ----
;; Encodes a file PATH with COMMAND, leaving the result in the
;; current buffer.
(defun gnus-uu-post-encode-file (command path file-name)
! (eq 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.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/gnus/gnus-uu.el,
Miles Bader <=