X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-uu.el;h=f937bbea06f3a07c58a6bf66beeb2fbac14c352e;hb=c1bc689888c18e12898bbc4c15161cf6618b12aa;hp=901560beb385bde78cbec99218c214a863ff068b;hpb=0cc53271ea14fabb9f2e7dacc9c44088ee8d4c43;p=gnus diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el index 901560beb..f937bbea0 100644 --- a/lisp/gnus-uu.el +++ b/lisp/gnus-uu.el @@ -1,7 +1,7 @@ ;;; gnus-uu.el --- extract (uu)encoded files in Gnus -;; Copyright (C) 1985,86,87,93,94,95,96,97 Free Software Foundation, Inc. +;; Copyright (C) 1985,86,87,93,94,95,96,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 ;; Keyword: news @@ -54,8 +54,8 @@ ;; Default viewing action rules (defcustom gnus-uu-default-view-rules - '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") - ("\\.pas$" "cat %s | sed s/\r//g") + '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'") + ("\\.pas$" "cat %s | sed 's/\r$//'") ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") ("\\.tga$" "tgatoppm %s | xv -") @@ -71,7 +71,7 @@ ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" "gnus-uu-archive")) - "Default actions to be taken when the user asks to view a file. + "*Default actions to be taken when the user asks to view a file. To change the behaviour, you can either edit this variable or set `gnus-uu-user-view-rules' to something useful. @@ -111,7 +111,7 @@ details." (defcustom gnus-uu-user-view-rules-end '(("" "file")) - "What actions are to be taken if no rule matched the file name. + "*What actions are to be taken if no rule matched the file name. See the documentation on the `gnus-uu-default-view-rules' variable for details." :group 'gnus-extract-view @@ -129,7 +129,7 @@ details." ("\\.Z$" "uncompress") ("\\.gz$" "gunzip") ("\\.arc$" "arc -x")) - "See `gnus-uu-user-archive-rules'." + "*See `gnus-uu-user-archive-rules'." :group 'gnus-extract-archive :type '(repeat (group regexp (string :tag "Command")))) @@ -290,8 +290,8 @@ so I simply dropped them." (defcustom gnus-uu-digest-headers '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" - "^Summary:" "^References:") - "List of regexps to match headers included in digested messages. + "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:") + "*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)) @@ -353,7 +353,9 @@ didn't work, and overwrite existing files. Otherwise, ask each time." "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 @@ -515,8 +517,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-setup-message 'forward (setq gnus-uu-digest-from-subject nil) (gnus-uu-decode-save n file) - (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) - (gnus-add-current-to-buffer-list) + (setq buf (switch-to-buffer + (gnus-get-buffer-create " *gnus-uu-forward*"))) (erase-buffer) (insert-file file) (let ((fs gnus-uu-digest-from-subject)) @@ -646,7 +648,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (gnus-summary-position-point)) (defun gnus-uu-mark-over (&optional score) - "Mark all articles with a score over SCORE (the prefix.)" + "Mark all articles with a score over SCORE (the prefix)." (interactive "P") (let ((score (gnus-score-default score)) (data gnus-newsgroup-data)) @@ -832,10 +834,10 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (eq in-state 'first-and-last)) (progn (setq state (list 'begin)) - (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) + (save-excursion (set-buffer (gnus-get-buffer-create "*gnus-uu-body*")) (erase-buffer)) (save-excursion - (set-buffer (get-buffer-create "*gnus-uu-pre*")) + (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*")) (erase-buffer) (insert (format "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" @@ -843,7 +845,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (when (not (eq in-state 'end)) (setq state (list 'middle)))) (save-excursion - (set-buffer (get-buffer "*gnus-uu-body*")) + (set-buffer "*gnus-uu-body*") (goto-char (setq beg (point-max))) (save-excursion (save-restriction @@ -885,16 +887,16 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (when (re-search-forward "^Subject: \\(.*\\)$" nil t) (setq subj (buffer-substring (match-beginning 1) (match-end 1))) (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) + (set-buffer "*gnus-uu-pre*") (insert (format " %s\n" subj))))) (when (or (eq in-state 'last) (eq in-state 'first-and-last)) (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) + (set-buffer "*gnus-uu-pre*") (insert (format "\n\n%s\n\n" (make-string 70 ?-))) (gnus-write-buffer gnus-uu-saved-article-name)) (save-excursion - (set-buffer (get-buffer "*gnus-uu-body*")) + (set-buffer "*gnus-uu-body*") (goto-char (point-max)) (insert (concat (setq end-string (format "End of %s Digest" name)) @@ -902,8 +904,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (insert (concat (make-string (length end-string) ?*) "\n")) (write-region (point-min) (point-max) gnus-uu-saved-article-name t)) - (kill-buffer (get-buffer "*gnus-uu-pre*")) - (kill-buffer (get-buffer "*gnus-uu-body*")) + (gnus-kill-buffer "*gnus-uu-pre*") + (gnus-kill-buffer "*gnus-uu-body*") (push 'end state)) (if (memq 'begin state) (cons gnus-uu-saved-article-name state) @@ -968,7 +970,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (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)) + (set-buffer (gnus-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")) @@ -1018,43 +1020,35 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-reginize-string (string) ;; Takes a string and puts a \ in front of every special character; - ;; ignores any leading "version numbers" thingies that they use in - ;; the comp.binaries groups, and either replaces anything that looks - ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something - ;; like that, replaces the last two numbers with "[0-9]+". This, in - ;; my experience, should get most postings of a series. - (let ((count 2) - (vernum "v[0-9]+[a-z][0-9]+:") - beg) + ;; replaces the last thing that looks like "2/3" with "[0-9]+/3" + ;; or, if it can't find something like that, tries "2 of 3", then + ;; finally just replaces the next to last number with "[0-9]+". + (let ((count 2)) (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) (buffer-disable-undo (current-buffer)) (erase-buffer) (insert (regexp-quote string)) - (setq beg 1) (setq case-fold-search nil) - (goto-char (point-min)) - (when (looking-at vernum) - (replace-match vernum t t) - (setq beg (length vernum))) - (goto-char beg) - (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t) - (replace-match " [0-9]+/[0-9]+") + (end-of-line) + (if (re-search-backward "\\([^0-9]\\)[0-9]+/\\([0-9]+\\)" nil t) + (replace-match "\\1[0-9]+/\\2") - (goto-char beg) - (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t) - (replace-match "[0-9]+ of [0-9]+") + (end-of-line) + (if (re-search-backward "\\([^0-9]\\)[0-9]+[ \t]*of[ \t]*\\([0-9]+\\)" + nil t) + (replace-match "\\1[0-9]+ of \\2") (end-of-line) (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" nil t) (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) - (goto-char beg) + (goto-char 1) (while (re-search-forward "[ \t]+" nil t) - (replace-match "[ \t]*" t t)) + (replace-match "[ \t]+" t t)) (buffer-substring 1 (point-max))))) @@ -1132,7 +1126,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (let ((out-list string-list) string) (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name)) (buffer-disable-undo (current-buffer)) (while string-list (erase-buffer) @@ -1297,7 +1291,8 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (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))) + (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 @@ -1355,11 +1350,18 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (defun gnus-uu-part-number (article) (let* ((header (gnus-summary-article-header article)) - (subject (and header (mail-header-subject header)))) - (if (and subject - (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) - (match-string 0 subject) - ""))) + (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))) @@ -1417,7 +1419,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (setq gnus-uu-uudecode-process (start-process "*uudecode*" - (get-buffer-create gnus-uu-output-buffer-name) + (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)))) @@ -1440,7 +1442,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." ;; Try to correct mishandled uucode. (when gnus-uu-correct-stripped-uucode (gnus-uu-check-correct-stripped-uucode start-char (point))) - (run-hooks 'gnus-uu-pre-uudecode-hook) + (gnus-run-hooks 'gnus-uu-pre-uudecode-hook) ;; Send the text to the process. (condition-case nil @@ -1483,7 +1485,7 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (setq start-char (point)) (call-process-region start-char (point-max) shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-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")))) @@ -1546,13 +1548,13 @@ didn't work, and overwrite existing files. Otherwise, ask each time." (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (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 - (get-buffer-create gnus-uu-output-buffer-name) + (gnus-get-buffer-create gnus-uu-output-buffer-name) nil shell-command-switch command)) (message "") (gnus-message 2 "Error during unpacking of archive") @@ -1899,8 +1901,10 @@ If no file has been included, the user will be asked for a file." (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)) @@ -1908,7 +1912,7 @@ If no file has been included, the user will be asked for a file." (unwind-protect (if (save-excursion (set-buffer (setq uubuf - (get-buffer-create uuencode-buffer-name))) + (gnus-get-buffer-create uuencode-buffer-name))) (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) (insert-buffer-substring uubuf) @@ -1941,7 +1945,7 @@ If no file has been included, the user will be asked for a file." (setq end-binary (point-max)) (save-excursion - (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) + (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)) @@ -1973,7 +1977,7 @@ If no file has been included, the user will be asked for a file." (setq i 1) (setq beg 1) (while (not (> i parts)) - (set-buffer (get-buffer-create send-buffer-name)) + (set-buffer (gnus-get-buffer-create send-buffer-name)) (erase-buffer) (insert header) (when (and threaded gnus-uu-post-message-id)