Mercurial > hg > xemacs-beta
comparison lisp/gnus/gnus-uu.el @ 108:360340f9fd5f r20-1b6
Import from CVS: tag r20-1b6
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 09:18:39 +0200 |
| parents | cf808b4c4290 |
| children | fe104dbd9147 |
comparison
equal
deleted
inserted
replaced
| 107:523141596bda | 108:360340f9fd5f |
|---|---|
| 22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 23 ;; Boston, MA 02111-1307, USA. | 23 ;; Boston, MA 02111-1307, USA. |
| 24 | 24 |
| 25 ;;; Commentary: | 25 ;;; Commentary: |
| 26 | 26 |
| 27 ;;; Code: | 27 ;;; Code: |
| 28 | 28 |
| 29 (require 'gnus) | 29 (require 'gnus) |
| 30 (require 'gnus-art) | 30 (require 'gnus-art) |
| 31 (require 'message) | 31 (require 'message) |
| 32 (require 'gnus-msg) | 32 (require 'gnus-msg) |
| 49 :prefix "gnus-uu-post" | 49 :prefix "gnus-uu-post" |
| 50 :group 'gnus-extract) | 50 :group 'gnus-extract) |
| 51 | 51 |
| 52 ;; Default viewing action rules | 52 ;; Default viewing action rules |
| 53 | 53 |
| 54 (defcustom gnus-uu-default-view-rules | 54 (defcustom gnus-uu-default-view-rules |
| 55 '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") | 55 '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") |
| 56 ("\\.pas$" "cat %s | sed s/\r//g") | 56 ("\\.pas$" "cat %s | sed s/\r//g") |
| 57 ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") | 57 ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") |
| 58 ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") | 58 ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") |
| 59 ("\\.tga$" "tgatoppm %s | xv -") | 59 ("\\.tga$" "tgatoppm %s | xv -") |
| 60 ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" | 60 ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" |
| 61 "sox -v .5 %s -t .au -u - > /dev/audio") | 61 "sox -v .5 %s -t .au -u - > /dev/audio") |
| 62 ("\\.au$" "cat %s > /dev/audio") | 62 ("\\.au$" "cat %s > /dev/audio") |
| 63 ("\\.midi?$" "playmidi -f") | 63 ("\\.midi?$" "playmidi -f") |
| 64 ("\\.mod$" "str32") | 64 ("\\.mod$" "str32") |
| 65 ("\\.ps$" "ghostview") | 65 ("\\.ps$" "ghostview") |
| 66 ("\\.dvi$" "xdvi") | 66 ("\\.dvi$" "xdvi") |
| 67 ("\\.html$" "xmosaic") | 67 ("\\.html$" "xmosaic") |
| 68 ("\\.mpe?g$" "mpeg_play") | 68 ("\\.mpe?g$" "mpeg_play") |
| 69 ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") | 69 ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") |
| 70 ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" | 70 ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" |
| 71 "gnus-uu-archive")) | 71 "gnus-uu-archive")) |
| 72 "Default actions to be taken when the user asks to view a file. | 72 "Default actions to be taken when the user asks to view a file. |
| 73 To change the behaviour, you can either edit this variable or set | 73 To change the behaviour, you can either edit this variable or set |
| 74 `gnus-uu-user-view-rules' to something useful. | 74 `gnus-uu-user-view-rules' to something useful. |
| 75 | 75 |
| 76 For example: | 76 For example: |
| 77 | 77 |
| 98 match here, it uses `gnus-uu-user-view-rules-end' to try to make a | 98 match here, it uses `gnus-uu-user-view-rules-end' to try to make a |
| 99 match." | 99 match." |
| 100 :group 'gnus-extract-view | 100 :group 'gnus-extract-view |
| 101 :type '(repeat (group regexp (string :tag "Command")))) | 101 :type '(repeat (group regexp (string :tag "Command")))) |
| 102 | 102 |
| 103 (defcustom gnus-uu-user-view-rules nil | 103 (defcustom gnus-uu-user-view-rules nil |
| 104 "What actions are to be taken to view a file. | 104 "What actions are to be taken to view a file. |
| 105 See the documentation on the `gnus-uu-default-view-rules' variable for | 105 See the documentation on the `gnus-uu-default-view-rules' variable for |
| 106 details." | 106 details." |
| 107 :group 'gnus-extract-view | 107 :group 'gnus-extract-view |
| 108 :type '(repeat (group regexp (string :tag "Command")))) | 108 :type '(repeat (group regexp (string :tag "Command")))) |
| 109 | 109 |
| 110 (defcustom gnus-uu-user-view-rules-end | 110 (defcustom gnus-uu-user-view-rules-end |
| 111 '(("" "file")) | 111 '(("" "file")) |
| 112 "What actions are to be taken if no rule matched the file name. | 112 "What actions are to be taken if no rule matched the file name. |
| 113 See the documentation on the `gnus-uu-default-view-rules' variable for | 113 See the documentation on the `gnus-uu-default-view-rules' variable for |
| 114 details." | 114 details." |
| 115 :group 'gnus-extract-view | 115 :group 'gnus-extract-view |
| 116 :type '(repeat (group regexp (string :tag "Command")))) | 116 :type '(repeat (group regexp (string :tag "Command")))) |
| 117 | 117 |
| 118 ;; Default unpacking commands | 118 ;; Default unpacking commands |
| 119 | 119 |
| 120 (defcustom gnus-uu-default-archive-rules | 120 (defcustom gnus-uu-default-archive-rules |
| 121 '(("\\.tar$" "tar xf") | 121 '(("\\.tar$" "tar xf") |
| 122 ("\\.zip$" "unzip -o") | 122 ("\\.zip$" "unzip -o") |
| 123 ("\\.ar$" "ar x") | 123 ("\\.ar$" "ar x") |
| 124 ("\\.arj$" "unarj x") | 124 ("\\.arj$" "unarj x") |
| 125 ("\\.zoo$" "zoo -e") | 125 ("\\.zoo$" "zoo -e") |
| 129 ("\\.arc$" "arc -x")) | 129 ("\\.arc$" "arc -x")) |
| 130 "See `gnus-uu-user-archive-rules'." | 130 "See `gnus-uu-user-archive-rules'." |
| 131 :group 'gnus-extract-archive | 131 :group 'gnus-extract-archive |
| 132 :type '(repeat (group regexp (string :tag "Command")))) | 132 :type '(repeat (group regexp (string :tag "Command")))) |
| 133 | 133 |
| 134 (defvar gnus-uu-destructive-archivers | 134 (defvar gnus-uu-destructive-archivers |
| 135 (list "uncompress" "gunzip")) | 135 (list "uncompress" "gunzip")) |
| 136 | 136 |
| 137 (defcustom gnus-uu-user-archive-rules nil | 137 (defcustom gnus-uu-user-archive-rules nil |
| 138 "A list that can be set to override the default archive unpacking commands. | 138 "A list that can be set to override the default archive unpacking commands. |
| 139 To use, for instance, 'untar' to unpack tar files and 'zip -x' to | 139 To use, for instance, 'untar' to unpack tar files and 'zip -x' to |
| 140 unpack zip files, say the following: | 140 unpack zip files, say the following: |
| 141 (setq gnus-uu-user-archive-rules | 141 (setq gnus-uu-user-archive-rules |
| 142 '((\"\\\\.tar$\" \"untar\") | 142 '((\"\\\\.tar$\" \"untar\") |
| 143 (\"\\\\.zip$\" \"zip -x\")))" | 143 (\"\\\\.zip$\" \"zip -x\")))" |
| 144 :group 'gnus-extract-archive | 144 :group 'gnus-extract-archive |
| 145 :type '(repeat (group regexp (string :tag "Command")))) | 145 :type '(repeat (group regexp (string :tag "Command")))) |
| 146 | 146 |
| 147 (defcustom gnus-uu-ignore-files-by-name nil | 147 (defcustom gnus-uu-ignore-files-by-name nil |
| 148 "*A regular expression saying what files should not be viewed based on name. | 148 "*A regular expression saying what files should not be viewed based on name. |
| 149 If, for instance, you want gnus-uu to ignore all .au and .wav files, | 149 If, for instance, you want gnus-uu to ignore all .au and .wav files, |
| 150 you could say something like | 150 you could say something like |
| 151 | 151 |
| 152 (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") | 152 (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") |
| 153 | 153 |
| 154 Note that this variable can be used in conjunction with the | 154 Note that this variable can be used in conjunction with the |
| 157 :type '(choice (const :tag "off" nil) | 157 :type '(choice (const :tag "off" nil) |
| 158 (regexp :format "%v"))) | 158 (regexp :format "%v"))) |
| 159 | 159 |
| 160 (defcustom gnus-uu-ignore-files-by-type nil | 160 (defcustom gnus-uu-ignore-files-by-type nil |
| 161 "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. | 161 "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. |
| 162 If, for instance, you want gnus-uu to ignore all audio files and all mpegs, | 162 If, for instance, you want gnus-uu to ignore all audio files and all mpegs, |
| 163 you could say something like | 163 you could say something like |
| 164 | 164 |
| 165 (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") | 165 (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") |
| 166 | 166 |
| 167 Note that this variable can be used in conjunction with the | 167 Note that this variable can be used in conjunction with the |
| 209 ("\\.dl$" "video/dl") | 209 ("\\.dl$" "video/dl") |
| 210 ("\\.qt$" "video/qt") | 210 ("\\.qt$" "video/qt") |
| 211 ("\\.rsrc$" "video/rsrc") | 211 ("\\.rsrc$" "video/rsrc") |
| 212 ("\\..*$" "unknown/unknown"))) | 212 ("\\..*$" "unknown/unknown"))) |
| 213 | 213 |
| 214 ;; Various variables users may set | 214 ;; Various variables users may set |
| 215 | 215 |
| 216 (defcustom gnus-uu-tmp-dir "/tmp/" | 216 (defcustom gnus-uu-tmp-dir "/tmp/" |
| 217 "*Variable saying where gnus-uu is to do its work. | 217 "*Variable saying where gnus-uu is to do its work. |
| 218 Default is \"/tmp/\"." | 218 Default is \"/tmp/\"." |
| 219 :group 'gnus-extract | 219 :group 'gnus-extract |
| 220 :type 'directory) | 220 :type 'directory) |
| 221 | 221 |
| 222 (defcustom gnus-uu-do-not-unpack-archives nil | 222 (defcustom gnus-uu-do-not-unpack-archives nil |
| 223 "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. | 223 "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. |
| 224 Default is nil." | 224 Default is nil." |
| 225 :group 'gnus-extract-archive | 225 :group 'gnus-extract-archive |
| 226 :type 'boolean) | 226 :type 'boolean) |
| 227 | 227 |
| 228 (defcustom gnus-uu-ignore-default-view-rules nil | 228 (defcustom gnus-uu-ignore-default-view-rules nil |
| 232 :type 'boolean) | 232 :type 'boolean) |
| 233 | 233 |
| 234 (defcustom gnus-uu-grabbed-file-functions nil | 234 (defcustom gnus-uu-grabbed-file-functions nil |
| 235 "Functions run on each file after successful decoding. | 235 "Functions run on each file after successful decoding. |
| 236 They will be called with the name of the file as the argument. | 236 They will be called with the name of the file as the argument. |
| 237 Likely functions you can use in this list are `gnus-uu-grab-view' | 237 Likely functions you can use in this list are `gnus-uu-grab-view' |
| 238 and `gnus-uu-grab-move'." | 238 and `gnus-uu-grab-move'." |
| 239 :group 'gnus-extract | 239 :group 'gnus-extract |
| 240 :options '(gnus-uu-grab-view gnus-uu-grab-move) | 240 :options '(gnus-uu-grab-view gnus-uu-grab-move) |
| 241 :type 'hook) | 241 :type 'hook) |
| 242 | 242 |
| 243 (defcustom gnus-uu-ignore-default-archive-rules nil | 243 (defcustom gnus-uu-ignore-default-archive-rules nil |
| 244 "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. | 244 "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. |
| 245 Only the user unpacking commands will be consulted. Default is nil." | 245 Only the user unpacking commands will be consulted. Default is nil." |
| 246 :group 'gnus-extract-archive | 246 :group 'gnus-extract-archive |
| 247 :type 'boolean) | 247 :type 'boolean) |
| 248 | 248 |
| 249 (defcustom gnus-uu-kill-carriage-return t | 249 (defcustom gnus-uu-kill-carriage-return t |
| 259 it nil." | 259 it nil." |
| 260 :group 'gnus-extract | 260 :group 'gnus-extract |
| 261 :type 'boolean) | 261 :type 'boolean) |
| 262 | 262 |
| 263 (defcustom gnus-uu-unmark-articles-not-decoded nil | 263 (defcustom gnus-uu-unmark-articles-not-decoded nil |
| 264 "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. | 264 "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. |
| 265 Default is nil." | 265 Default is nil." |
| 266 :group 'gnus-extract | 266 :group 'gnus-extract |
| 267 :type 'boolean) | 267 :type 'boolean) |
| 268 | 268 |
| 269 (defcustom gnus-uu-correct-stripped-uucode nil | 269 (defcustom gnus-uu-correct-stripped-uucode nil |
| 270 "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. | 270 "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. |
| 271 Default is nil." | 271 Default is nil." |
| 272 :group 'gnus-extract | 272 :group 'gnus-extract |
| 273 :type 'boolean) | 273 :type 'boolean) |
| 274 | 274 |
| 275 (defcustom gnus-uu-save-in-digest nil | 275 (defcustom gnus-uu-save-in-digest nil |
| 276 "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. | 276 "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. |
| 277 If this variable is nil, gnus-uu will just save everything in a | 277 If this variable is nil, gnus-uu will just save everything in a |
| 278 file without any embellishments. The digesting almost conforms to RFC1153 - | 278 file without any embellishments. The digesting almost conforms to RFC1153 - |
| 279 no easy way to specify any meaningful volume and issue numbers were found, | 279 no easy way to specify any meaningful volume and issue numbers were found, |
| 280 so I simply dropped them." | 280 so I simply dropped them." |
| 281 :group 'gnus-extract | 281 :group 'gnus-extract |
| 282 :type 'boolean) | 282 :type 'boolean) |
| 283 | 283 |
| 284 (defcustom gnus-uu-digest-headers | 284 (defcustom gnus-uu-digest-headers |
| 285 '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" | 285 '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" |
| 286 "^Summary:" "^References:") | 286 "^Summary:" "^References:") |
| 287 "List of regexps to match headers included in digested messages. | 287 "List of regexps to match headers included in digested messages. |
| 288 The headers will be included in the sequence they are matched." | 288 The headers will be included in the sequence they are matched." |
| 289 :group 'gnus-extract | 289 :group 'gnus-extract |
| 369 "b" gnus-uu-decode-binhex | 369 "b" gnus-uu-decode-binhex |
| 370 "B" gnus-uu-decode-binhex | 370 "B" gnus-uu-decode-binhex |
| 371 "p" gnus-uu-decode-postscript | 371 "p" gnus-uu-decode-postscript |
| 372 "P" gnus-uu-decode-postscript-and-save) | 372 "P" gnus-uu-decode-postscript-and-save) |
| 373 | 373 |
| 374 (gnus-define-keys | 374 (gnus-define-keys |
| 375 (gnus-uu-extract-view-map "v" gnus-uu-extract-map) | 375 (gnus-uu-extract-view-map "v" gnus-uu-extract-map) |
| 376 "u" gnus-uu-decode-uu-view | 376 "u" gnus-uu-decode-uu-view |
| 377 "U" gnus-uu-decode-uu-and-save-view | 377 "U" gnus-uu-decode-uu-and-save-view |
| 378 "s" gnus-uu-decode-unshar-view | 378 "s" gnus-uu-decode-unshar-view |
| 379 "S" gnus-uu-decode-unshar-and-save-view | 379 "S" gnus-uu-decode-unshar-and-save-view |
| 419 | 419 |
| 420 (defun gnus-uu-decode-save (n file) | 420 (defun gnus-uu-decode-save (n file) |
| 421 "Saves the current article." | 421 "Saves the current article." |
| 422 (interactive | 422 (interactive |
| 423 (list current-prefix-arg | 423 (list current-prefix-arg |
| 424 (read-file-name | 424 (read-file-name |
| 425 (if gnus-uu-save-separate-articles | 425 (if gnus-uu-save-separate-articles |
| 426 "Save articles is dir: " | 426 "Save articles is dir: " |
| 427 "Save articles in file: ") | 427 "Save articles in file: ") |
| 428 gnus-uu-default-dir | 428 gnus-uu-default-dir |
| 429 gnus-uu-default-dir))) | 429 gnus-uu-default-dir))) |
| 436 (list current-prefix-arg | 436 (list current-prefix-arg |
| 437 (file-name-as-directory | 437 (file-name-as-directory |
| 438 (read-file-name "Unbinhex and save in dir: " | 438 (read-file-name "Unbinhex and save in dir: " |
| 439 gnus-uu-default-dir | 439 gnus-uu-default-dir |
| 440 gnus-uu-default-dir)))) | 440 gnus-uu-default-dir)))) |
| 441 (setq gnus-uu-binhex-article-name | 441 (setq gnus-uu-binhex-article-name |
| 442 (make-temp-name (concat gnus-uu-work-dir "binhex"))) | 442 (make-temp-name (concat gnus-uu-work-dir "binhex"))) |
| 443 (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) | 443 (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) |
| 444 | 444 |
| 445 (defun gnus-uu-decode-uu-view (&optional n) | 445 (defun gnus-uu-decode-uu-view (&optional n) |
| 446 "Uudecodes and views the current article." | 446 "Uudecodes and views the current article." |
| 447 (interactive "P") | 447 (interactive "P") |
| 448 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) | 448 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) |
| 449 (gnus-uu-decode-uu n))) | 449 (gnus-uu-decode-uu n))) |
| 450 | 450 |
| 451 (defun gnus-uu-decode-uu-and-save-view (n dir) | 451 (defun gnus-uu-decode-uu-and-save-view (n dir) |
| 489 "Unbinhexes and views the current article." | 489 "Unbinhexes and views the current article." |
| 490 (interactive | 490 (interactive |
| 491 (list current-prefix-arg | 491 (list current-prefix-arg |
| 492 (read-file-name "Unbinhex, view and save in dir: " | 492 (read-file-name "Unbinhex, view and save in dir: " |
| 493 gnus-uu-default-dir gnus-uu-default-dir))) | 493 gnus-uu-default-dir gnus-uu-default-dir))) |
| 494 (setq gnus-uu-binhex-article-name | 494 (setq gnus-uu-binhex-article-name |
| 495 (make-temp-name (concat gnus-uu-work-dir "binhex"))) | 495 (make-temp-name (concat gnus-uu-work-dir "binhex"))) |
| 496 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) | 496 (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) |
| 497 (gnus-uu-decode-binhex n file))) | 497 (gnus-uu-decode-binhex n file))) |
| 498 | 498 |
| 499 | 499 |
| 526 subject) | 526 subject) |
| 527 (setq subject nil))) | 527 (setq subject nil))) |
| 528 (setq fs (cdr fs)))) | 528 (setq fs (cdr fs)))) |
| 529 (unless subject | 529 (unless subject |
| 530 (setq subject "Digested Articles")) | 530 (setq subject "Digested Articles")) |
| 531 (unless from | 531 (unless from |
| 532 (setq from | 532 (setq from |
| 533 (if (gnus-news-group-p gnus-newsgroup-name) | 533 (if (gnus-news-group-p gnus-newsgroup-name) |
| 534 gnus-newsgroup-name | 534 gnus-newsgroup-name |
| 535 "Various")))) | 535 "Various")))) |
| 536 (goto-char (point-min)) | 536 (goto-char (point-min)) |
| 601 | 601 |
| 602 (defun gnus-uu-mark-buffer () | 602 (defun gnus-uu-mark-buffer () |
| 603 "Set the process mark on all articles in the buffer." | 603 "Set the process mark on all articles in the buffer." |
| 604 (interactive) | 604 (interactive) |
| 605 (gnus-uu-mark-region (point-min) (point-max))) | 605 (gnus-uu-mark-region (point-min) (point-max))) |
| 606 | 606 |
| 607 (defun gnus-uu-unmark-buffer () | 607 (defun gnus-uu-unmark-buffer () |
| 608 "Remove the process mark on all articles in the buffer." | 608 "Remove the process mark on all articles in the buffer." |
| 609 (interactive) | 609 (interactive) |
| 610 (gnus-uu-mark-region (point-min) (point-max) t)) | 610 (gnus-uu-mark-region (point-min) (point-max) t)) |
| 611 | 611 |
| 612 (defun gnus-uu-mark-thread () | 612 (defun gnus-uu-mark-thread () |
| 613 "Marks all articles downwards in this thread." | 613 "Marks all articles downwards in this thread." |
| 614 (interactive) | 614 (interactive) |
| 615 (gnus-set-global-variables) | 615 (gnus-set-global-variables) |
| 616 (let ((level (gnus-summary-thread-level))) | 616 (let ((level (gnus-summary-thread-level))) |
| 666 (unless marked | 666 (unless marked |
| 667 (error "No articles marked with the process mark")) | 667 (error "No articles marked with the process mark")) |
| 668 (setq gnus-newsgroup-processable nil) | 668 (setq gnus-newsgroup-processable nil) |
| 669 (save-excursion | 669 (save-excursion |
| 670 (while marked | 670 (while marked |
| 671 (and (vectorp (setq headers | 671 (and (vectorp (setq headers |
| 672 (gnus-summary-article-header (car marked)))) | 672 (gnus-summary-article-header (car marked)))) |
| 673 (setq subject (mail-header-subject headers) | 673 (setq subject (mail-header-subject headers) |
| 674 articles (gnus-uu-find-articles-matching | 674 articles (gnus-uu-find-articles-matching |
| 675 (gnus-uu-reginize-string subject)) | 675 (gnus-uu-reginize-string subject)) |
| 676 total (nconc total articles))) | 676 total (nconc total articles))) |
| 677 (while articles | 677 (while articles |
| 678 (gnus-summary-set-process-mark (car articles)) | 678 (gnus-summary-set-process-mark (car articles)) |
| 679 (setcdr marked (delq (car articles) (cdr marked))) | 679 (setcdr marked (delq (car articles) (cdr marked))) |
| 697 (gnus-summary-goto-subject number) | 697 (gnus-summary-goto-subject number) |
| 698 (gnus-uu-mark-series)) | 698 (gnus-uu-mark-series)) |
| 699 (setq data (cdr data))))) | 699 (setq data (cdr data))))) |
| 700 (gnus-summary-position-point)) | 700 (gnus-summary-position-point)) |
| 701 | 701 |
| 702 ;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>. | 702 ;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>. |
| 703 | 703 |
| 704 (defun gnus-uu-decode-postscript (&optional n) | 704 (defun gnus-uu-decode-postscript (&optional n) |
| 705 "Gets postscript of the current article." | 705 "Gets postscript of the current article." |
| 706 (interactive "P") | 706 (interactive "P") |
| 707 (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) | 707 (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) |
| 718 (list current-prefix-arg | 718 (list current-prefix-arg |
| 719 (file-name-as-directory | 719 (file-name-as-directory |
| 720 (read-file-name "Save in dir: " | 720 (read-file-name "Save in dir: " |
| 721 gnus-uu-default-dir | 721 gnus-uu-default-dir |
| 722 gnus-uu-default-dir t)))) | 722 gnus-uu-default-dir t)))) |
| 723 (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article | 723 (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article |
| 724 n dir nil nil t)) | 724 n dir nil nil t)) |
| 725 | 725 |
| 726 (defun gnus-uu-decode-postscript-and-save-view (n dir) | 726 (defun gnus-uu-decode-postscript-and-save-view (n dir) |
| 727 "Decodes, views and saves the resulting file." | 727 "Decodes, views and saves the resulting file." |
| 728 (interactive | 728 (interactive |
| 734 (gnus-uu-decode-postscript-and-save n dir))) | 734 (gnus-uu-decode-postscript-and-save n dir))) |
| 735 | 735 |
| 736 | 736 |
| 737 ;; Internal functions. | 737 ;; Internal functions. |
| 738 | 738 |
| 739 (defun gnus-uu-decode-with-method (method n &optional save not-insert | 739 (defun gnus-uu-decode-with-method (method n &optional save not-insert |
| 740 scan cdir) | 740 scan cdir) |
| 741 (gnus-uu-initialize scan) | 741 (gnus-uu-initialize scan) |
| 742 (when save | 742 (when save |
| 743 (setq gnus-uu-default-dir save)) | 743 (setq gnus-uu-default-dir save)) |
| 744 ;; Create the directory we save to. | 744 ;; Create the directory we save to. |
| 768 (push (list (cons 'name file) | 768 (push (list (cons 'name file) |
| 769 (cons 'article gnus-current-article)) | 769 (cons 'article gnus-current-article)) |
| 770 out) | 770 out) |
| 771 (when (file-directory-p file) | 771 (when (file-directory-p file) |
| 772 (setq out (nconc (gnus-uu-scan-directory file t) out))))) | 772 (setq out (nconc (gnus-uu-scan-directory file t) out))))) |
| 773 (if rec | 773 (if rec |
| 774 out | 774 out |
| 775 (nreverse out)))) | 775 (nreverse out)))) |
| 776 | 776 |
| 777 (defun gnus-uu-save-files (files dir) | 777 (defun gnus-uu-save-files (files dir) |
| 778 "Save FILES in DIR." | 778 "Save FILES in DIR." |
| 797 ;; Functions for saving and possibly digesting articles without | 797 ;; Functions for saving and possibly digesting articles without |
| 798 ;; any decoding. | 798 ;; any decoding. |
| 799 | 799 |
| 800 ;; Function called by gnus-uu-grab-articles to treat each article. | 800 ;; Function called by gnus-uu-grab-articles to treat each article. |
| 801 (defun gnus-uu-save-article (buffer in-state) | 801 (defun gnus-uu-save-article (buffer in-state) |
| 802 (cond | 802 (cond |
| 803 (gnus-uu-save-separate-articles | 803 (gnus-uu-save-separate-articles |
| 804 (save-excursion | 804 (save-excursion |
| 805 (set-buffer buffer) | 805 (set-buffer buffer) |
| 806 (gnus-write-buffer | 806 (gnus-write-buffer |
| 807 (concat gnus-uu-saved-article-name gnus-current-article)) | 807 (concat gnus-uu-saved-article-name gnus-current-article)) |
| 808 (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) | 808 (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) |
| 809 ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name | 809 ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name |
| 810 'begin 'end)) | 810 'begin 'end)) |
| 811 ((eq in-state 'last) (list 'end)) | 811 ((eq in-state 'last) (list 'end)) |
| 812 (t (list 'middle))))) | 812 (t (list 'middle))))) |
| 813 ((not gnus-uu-save-in-digest) | 813 ((not gnus-uu-save-in-digest) |
| 814 (save-excursion | 814 (save-excursion |
| 815 (set-buffer buffer) | 815 (set-buffer buffer) |
| 816 (write-region (point-min) (point-max) gnus-uu-saved-article-name t) | 816 (write-region (point-min) (point-max) gnus-uu-saved-article-name t) |
| 817 (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) | 817 (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) |
| 818 ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name | 818 ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name |
| 819 'begin 'end)) | 819 'begin 'end)) |
| 820 ((eq in-state 'last) (list 'end)) | 820 ((eq in-state 'last) (list 'end)) |
| 821 (t (list 'middle))))) | 821 (t (list 'middle))))) |
| 822 (t | 822 (t |
| 823 (let ((header (gnus-summary-article-header))) | 823 (let ((header (gnus-summary-article-header))) |
| 827 (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) | 827 (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) |
| 828 (delim (concat "^" (make-string 30 ?-) "$")) | 828 (delim (concat "^" (make-string 30 ?-) "$")) |
| 829 beg subj headers headline sorthead body end-string state) | 829 beg subj headers headline sorthead body end-string state) |
| 830 (if (or (eq in-state 'first) | 830 (if (or (eq in-state 'first) |
| 831 (eq in-state 'first-and-last)) | 831 (eq in-state 'first-and-last)) |
| 832 (progn | 832 (progn |
| 833 (setq state (list 'begin)) | 833 (setq state (list 'begin)) |
| 834 (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) | 834 (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) |
| 835 (erase-buffer)) | 835 (erase-buffer)) |
| 836 (save-excursion | 836 (save-excursion |
| 837 (set-buffer (get-buffer-create "*gnus-uu-pre*")) | 837 (set-buffer (get-buffer-create "*gnus-uu-pre*")) |
| 838 (erase-buffer) | 838 (erase-buffer) |
| 839 (insert (format | 839 (insert (format |
| 840 "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" | 840 "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" |
| 841 (current-time-string) name name)))) | 841 (current-time-string) name name)))) |
| 842 (when (not (eq in-state 'end)) | 842 (when (not (eq in-state 'end)) |
| 843 (setq state (list 'middle)))) | 843 (setq state (list 'middle)))) |
| 844 (save-excursion | 844 (save-excursion |
| 867 (while headers | 867 (while headers |
| 868 (setq headline (car headers)) | 868 (setq headline (car headers)) |
| 869 (setq headers (cdr headers)) | 869 (setq headers (cdr headers)) |
| 870 (goto-char (point-min)) | 870 (goto-char (point-min)) |
| 871 (while (re-search-forward headline nil t) | 871 (while (re-search-forward headline nil t) |
| 872 (setq sorthead | 872 (setq sorthead |
| 873 (concat sorthead | 873 (concat sorthead |
| 874 (buffer-substring | 874 (buffer-substring |
| 875 (match-beginning 0) | 875 (match-beginning 0) |
| 876 (or (and (re-search-forward "^[^ \t]" nil t) | 876 (or (and (re-search-forward "^[^ \t]" nil t) |
| 877 (1- (point))) | 877 (1- (point))) |
| 878 (progn (forward-line 1) (point))))))))) | 878 (progn (forward-line 1) (point))))))))) |
| 879 (widen))) | 879 (widen))) |
| 881 (insert body) (goto-char (point-max)) | 881 (insert body) (goto-char (point-max)) |
| 882 (insert (concat "\n" (make-string 30 ?-) "\n\n")) | 882 (insert (concat "\n" (make-string 30 ?-) "\n\n")) |
| 883 (goto-char beg) | 883 (goto-char beg) |
| 884 (when (re-search-forward "^Subject: \\(.*\\)$" nil t) | 884 (when (re-search-forward "^Subject: \\(.*\\)$" nil t) |
| 885 (setq subj (buffer-substring (match-beginning 1) (match-end 1))) | 885 (setq subj (buffer-substring (match-beginning 1) (match-end 1))) |
| 886 (save-excursion | 886 (save-excursion |
| 887 (set-buffer (get-buffer "*gnus-uu-pre*")) | 887 (set-buffer (get-buffer "*gnus-uu-pre*")) |
| 888 (insert (format " %s\n" subj))))) | 888 (insert (format " %s\n" subj))))) |
| 889 (when (or (eq in-state 'last) | 889 (when (or (eq in-state 'last) |
| 890 (eq in-state 'first-and-last)) | 890 (eq in-state 'first-and-last)) |
| 891 (save-excursion | 891 (save-excursion |
| 893 (insert (format "\n\n%s\n\n" (make-string 70 ?-))) | 893 (insert (format "\n\n%s\n\n" (make-string 70 ?-))) |
| 894 (gnus-write-buffer gnus-uu-saved-article-name)) | 894 (gnus-write-buffer gnus-uu-saved-article-name)) |
| 895 (save-excursion | 895 (save-excursion |
| 896 (set-buffer (get-buffer "*gnus-uu-body*")) | 896 (set-buffer (get-buffer "*gnus-uu-body*")) |
| 897 (goto-char (point-max)) | 897 (goto-char (point-max)) |
| 898 (insert | 898 (insert |
| 899 (concat (setq end-string (format "End of %s Digest" name)) | 899 (concat (setq end-string (format "End of %s Digest" name)) |
| 900 "\n")) | 900 "\n")) |
| 901 (insert (concat (make-string (length end-string) ?*) "\n")) | 901 (insert (concat (make-string (length end-string) ?*) "\n")) |
| 902 (write-region | 902 (write-region |
| 903 (point-min) (point-max) gnus-uu-saved-article-name t)) | 903 (point-min) (point-max) gnus-uu-saved-article-name t)) |
| 906 (push 'end state)) | 906 (push 'end state)) |
| 907 (if (memq 'begin state) | 907 (if (memq 'begin state) |
| 908 (cons gnus-uu-saved-article-name state) | 908 (cons gnus-uu-saved-article-name state) |
| 909 state))))) | 909 state))))) |
| 910 | 910 |
| 911 ;; Binhex treatment - not very advanced. | 911 ;; Binhex treatment - not very advanced. |
| 912 | 912 |
| 913 (defconst gnus-uu-binhex-body-line | 913 (defconst gnus-uu-binhex-body-line |
| 914 "^[^:]...............................................................$") | 914 "^[^:]...............................................................$") |
| 915 (defconst gnus-uu-binhex-begin-line | 915 (defconst gnus-uu-binhex-begin-line |
| 916 "^:...............................................................$") | 916 "^:...............................................................$") |
| 917 (defconst gnus-uu-binhex-end-line | 917 (defconst gnus-uu-binhex-end-line |
| 918 ":$") | 918 ":$") |
| 919 | 919 |
| 920 (defun gnus-uu-binhex-article (buffer in-state) | 920 (defun gnus-uu-binhex-article (buffer in-state) |
| 935 (progn | 935 (progn |
| 936 (setq state (list 'begin)) | 936 (setq state (list 'begin)) |
| 937 (write-region 1 1 gnus-uu-binhex-article-name)) | 937 (write-region 1 1 gnus-uu-binhex-article-name)) |
| 938 (setq state (list 'middle))) | 938 (setq state (list 'middle))) |
| 939 (goto-char (point-max)) | 939 (goto-char (point-max)) |
| 940 (re-search-backward (concat gnus-uu-binhex-body-line "\\|" | 940 (re-search-backward (concat gnus-uu-binhex-body-line "\\|" |
| 941 gnus-uu-binhex-end-line) | 941 gnus-uu-binhex-end-line) |
| 942 nil t) | 942 nil t) |
| 943 (when (looking-at gnus-uu-binhex-end-line) | 943 (when (looking-at gnus-uu-binhex-end-line) |
| 944 (setq state (if (memq 'begin state) | 944 (setq state (if (memq 'begin state) |
| 945 (cons 'end state) | 945 (cons 'end state) |
| 972 (setq file-name (concat gnus-uu-work-dir | 972 (setq file-name (concat gnus-uu-work-dir |
| 973 (cdr gnus-article-current) ".ps")) | 973 (cdr gnus-article-current) ".ps")) |
| 974 (write-region (point-min) (point-max) file-name) | 974 (write-region (point-min) (point-max) file-name) |
| 975 (setq state (list file-name 'begin 'end))))) | 975 (setq state (list file-name 'begin 'end))))) |
| 976 state)) | 976 state)) |
| 977 | 977 |
| 978 | 978 |
| 979 ;; Find actions. | 979 ;; Find actions. |
| 980 | 980 |
| 981 (defun gnus-uu-get-actions (files) | 981 (defun gnus-uu-get-actions (files) |
| 982 (let ((ofiles files) | 982 (let ((ofiles files) |
| 983 action name) | 983 action name) |
| 984 (while files | 984 (while files |
| 985 (setq name (cdr (assq 'name (car files)))) | 985 (setq name (cdr (assq 'name (car files)))) |
| 986 (and | 986 (and |
| 987 (setq action (gnus-uu-get-action name)) | 987 (setq action (gnus-uu-get-action name)) |
| 988 (setcar files (nconc (list (if (string= action "gnus-uu-archive") | 988 (setcar files (nconc (list (if (string= action "gnus-uu-archive") |
| 989 (cons 'action "file") | 989 (cons 'action "file") |
| 990 (cons 'action action)) | 990 (cons 'action action)) |
| 991 (cons 'execute (gnus-uu-command | 991 (cons 'execute (gnus-uu-command |
| 994 (setq files (cdr files))) | 994 (setq files (cdr files))) |
| 995 ofiles)) | 995 ofiles)) |
| 996 | 996 |
| 997 (defun gnus-uu-get-action (file-name) | 997 (defun gnus-uu-get-action (file-name) |
| 998 (let (action) | 998 (let (action) |
| 999 (setq action | 999 (setq action |
| 1000 (gnus-uu-choose-action | 1000 (gnus-uu-choose-action |
| 1001 file-name | 1001 file-name |
| 1002 (append | 1002 (append |
| 1003 gnus-uu-user-view-rules | 1003 gnus-uu-user-view-rules |
| 1004 (if gnus-uu-ignore-default-view-rules | 1004 (if gnus-uu-ignore-default-view-rules |
| 1005 nil | 1005 nil |
| 1006 gnus-uu-default-view-rules) | 1006 gnus-uu-default-view-rules) |
| 1007 gnus-uu-user-view-rules-end))) | 1007 gnus-uu-user-view-rules-end))) |
| 1008 (when (and (not (string= (or action "") "gnus-uu-archive")) | 1008 (when (and (not (string= (or action "") "gnus-uu-archive")) |
| 1009 gnus-uu-view-with-metamail) | 1009 gnus-uu-view-with-metamail) |
| 1010 (when (setq action | 1010 (when (setq action |
| 1011 (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) | 1011 (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) |
| 1012 (setq action (format "metamail -d -b -c \"%s\"" action)))) | 1012 (setq action (format "metamail -d -b -c \"%s\"" action)))) |
| 1013 action)) | 1013 action)) |
| 1014 | 1014 |
| 1015 | 1015 |
| 1048 | 1048 |
| 1049 (end-of-line) | 1049 (end-of-line) |
| 1050 (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" | 1050 (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" |
| 1051 nil t) | 1051 nil t) |
| 1052 (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) | 1052 (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) |
| 1053 | 1053 |
| 1054 (goto-char beg) | 1054 (goto-char beg) |
| 1055 (while (re-search-forward "[ \t]+" nil t) | 1055 (while (re-search-forward "[ \t]+" nil t) |
| 1056 (replace-match "[ \t]*" t t)) | 1056 (replace-match "[ \t]*" t t)) |
| 1057 | 1057 |
| 1058 (buffer-substring 1 (point-max))))) | 1058 (buffer-substring 1 (point-max))))) |
| 1059 | 1059 |
| 1060 (defun gnus-uu-get-list-of-articles (n) | 1060 (defun gnus-uu-get-list-of-articles (n) |
| 1061 ;; If N is non-nil, the article numbers of the N next articles | 1061 ;; If N is non-nil, the article numbers of the N next articles |
| 1062 ;; will be returned. | 1062 ;; will be returned. |
| 1063 ;; If any articles have been marked as processable, they will be | 1063 ;; If any articles have been marked as processable, they will be |
| 1064 ;; returned. | 1064 ;; returned. |
| 1065 ;; Failing that, articles that have subjects that are part of the | 1065 ;; Failing that, articles that have subjects that are part of the |
| 1066 ;; same "series" as the current will be returned. | 1066 ;; same "series" as the current will be returned. |
| 1067 (let (articles) | 1067 (let (articles) |
| 1068 (cond | 1068 (cond |
| 1069 (n | 1069 (n |
| 1070 (setq n (prefix-numeric-value n)) | 1070 (setq n (prefix-numeric-value n)) |
| 1071 (let ((backward (< n 0)) | 1071 (let ((backward (< n 0)) |
| 1072 (n (abs n))) | 1072 (n (abs n))) |
| 1073 (save-excursion | 1073 (save-excursion |
| 1083 (gnus-uu-find-articles-matching))))) | 1083 (gnus-uu-find-articles-matching))))) |
| 1084 | 1084 |
| 1085 (defun gnus-uu-string< (l1 l2) | 1085 (defun gnus-uu-string< (l1 l2) |
| 1086 (string< (car l1) (car l2))) | 1086 (string< (car l1) (car l2))) |
| 1087 | 1087 |
| 1088 (defun gnus-uu-find-articles-matching | 1088 (defun gnus-uu-find-articles-matching |
| 1089 (&optional subject only-unread do-not-translate) | 1089 (&optional subject only-unread do-not-translate) |
| 1090 ;; Finds all articles that matches the regexp SUBJECT. If it is | 1090 ;; Finds all articles that matches the regexp SUBJECT. If it is |
| 1091 ;; nil, the current article name will be used. If ONLY-UNREAD is | 1091 ;; nil, the current article name will be used. If ONLY-UNREAD is |
| 1092 ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is | 1092 ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is |
| 1093 ;; non-nil, article names are not equalized before sorting. | 1093 ;; non-nil, article names are not equalized before sorting. |
| 1094 (let ((subject (or subject | 1094 (let ((subject (or subject |
| 1095 (gnus-uu-reginize-string (gnus-summary-article-subject)))) | 1095 (gnus-uu-reginize-string (gnus-summary-article-subject)))) |
| 1096 list-of-subjects) | 1096 list-of-subjects) |
| 1097 (save-excursion | 1097 (save-excursion |
| 1098 (if (not subject) | 1098 (if (not subject) |
| 1099 () | 1099 () |
| 1115 list-of-subjects)))) | 1115 list-of-subjects)))) |
| 1116 | 1116 |
| 1117 ;; Expand numbers, sort, and return the list of article | 1117 ;; Expand numbers, sort, and return the list of article |
| 1118 ;; numbers. | 1118 ;; numbers. |
| 1119 (mapcar (lambda (sub) (cdr sub)) | 1119 (mapcar (lambda (sub) (cdr sub)) |
| 1120 (sort (gnus-uu-expand-numbers | 1120 (sort (gnus-uu-expand-numbers |
| 1121 list-of-subjects | 1121 list-of-subjects |
| 1122 (not do-not-translate)) | 1122 (not do-not-translate)) |
| 1123 'gnus-uu-string<)))))) | 1123 'gnus-uu-string<)))))) |
| 1124 | 1124 |
| 1125 (defun gnus-uu-expand-numbers (string-list &optional translate) | 1125 (defun gnus-uu-expand-numbers (string-list &optional translate) |
| 1140 (goto-char (point-min)) | 1140 (goto-char (point-min)) |
| 1141 (while (re-search-forward "[ \t]+" nil t) | 1141 (while (re-search-forward "[ \t]+" nil t) |
| 1142 (replace-match " ")) | 1142 (replace-match " ")) |
| 1143 ;; Translate all characters to "a". | 1143 ;; Translate all characters to "a". |
| 1144 (goto-char (point-min)) | 1144 (goto-char (point-min)) |
| 1145 (when translate | 1145 (when translate |
| 1146 (while (re-search-forward "[A-Za-z]" nil t) | 1146 (while (re-search-forward "[A-Za-z]" nil t) |
| 1147 (replace-match "a" t t))) | 1147 (replace-match "a" t t))) |
| 1148 ;; Expand numbers. | 1148 ;; Expand numbers. |
| 1149 (goto-char (point-min)) | 1149 (goto-char (point-min)) |
| 1150 (while (re-search-forward "[0-9]+" nil t) | 1150 (while (re-search-forward "[0-9]+" nil t) |
| 1151 (replace-match | 1151 (replace-match |
| 1152 (format "%06d" | 1152 (format "%06d" |
| 1153 (string-to-int (buffer-substring | 1153 (string-to-int (buffer-substring |
| 1154 (match-beginning 0) (match-end 0)))))) | 1154 (match-beginning 0) (match-end 0)))))) |
| 1155 (setq string (buffer-substring 1 (point-max))) | 1155 (setq string (buffer-substring 1 (point-max))) |
| 1156 (setcar (car string-list) string) | 1156 (setcar (car string-list) string) |
| 1157 (setq string-list (cdr string-list)))) | 1157 (setq string-list (cdr string-list)))) |
| 1158 out-list)) | 1158 out-list)) |
| 1197 (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) | 1197 (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) |
| 1198 (when dont-unmark-last-article | 1198 (when dont-unmark-last-article |
| 1199 (setq gnus-uu-has-been-grabbed (list art)))))) | 1199 (setq gnus-uu-has-been-grabbed (list art)))))) |
| 1200 | 1200 |
| 1201 ;; This function takes a list of articles and a function to apply to | 1201 ;; This function takes a list of articles and a function to apply to |
| 1202 ;; each article grabbed. | 1202 ;; each article grabbed. |
| 1203 ;; | 1203 ;; |
| 1204 ;; This function returns a list of files decoded if the grabbing and | 1204 ;; This function returns a list of files decoded if the grabbing and |
| 1205 ;; the process-function has been successful and nil otherwise. | 1205 ;; the process-function has been successful and nil otherwise. |
| 1206 (defun gnus-uu-grab-articles (articles process-function | 1206 (defun gnus-uu-grab-articles (articles process-function |
| 1207 &optional sloppy limit no-errors) | 1207 &optional sloppy limit no-errors) |
| 1208 (let ((state 'first) | 1208 (let ((state 'first) |
| 1209 (gnus-asynchronous nil) | 1209 (gnus-asynchronous nil) |
| 1210 has-been-begin article result-file result-files process-state | 1210 has-been-begin article result-file result-files process-state |
| 1211 gnus-summary-display-article-function | 1211 gnus-summary-display-article-function |
| 1212 gnus-article-display-hook gnus-article-prepare-hook | 1212 gnus-article-display-hook gnus-article-prepare-hook |
| 1213 article-series files) | 1213 article-series files) |
| 1214 | 1214 |
| 1215 (while (and articles | 1215 (while (and articles |
| 1216 (not (memq 'error process-state)) | 1216 (not (memq 'error process-state)) |
| 1217 (or sloppy | 1217 (or sloppy |
| 1218 (not (memq 'end process-state)))) | 1218 (not (memq 'end process-state)))) |
| 1219 | 1219 |
| 1220 (setq article (pop articles)) | 1220 (setq article (pop articles)) |
| 1221 (push article article-series) | 1221 (push article article-series) |
| 1222 | 1222 |
| 1223 (unless articles | 1223 (unless articles |
| 1224 (if (eq state 'first) | 1224 (if (eq state 'first) |
| 1225 (setq state 'first-and-last) | 1225 (setq state 'first-and-last) |
| 1226 (setq state 'last))) | 1226 (setq state 'last))) |
| 1227 | 1227 |
| 1228 (let ((part (gnus-uu-part-number article))) | 1228 (let ((part (gnus-uu-part-number article))) |
| 1229 (gnus-message 6 "Getting article %d%s..." | 1229 (gnus-message 6 "Getting article %d%s..." |
| 1230 article (if (string= part "") "" (concat ", " part)))) | 1230 article (if (string= part "") "" (concat ", " part)))) |
| 1231 (gnus-summary-display-article article) | 1231 (gnus-summary-display-article article) |
| 1232 | 1232 |
| 1233 ;; Push the article to the processing function. | 1233 ;; Push the article to the processing function. |
| 1234 (save-excursion | 1234 (save-excursion |
| 1235 (set-buffer gnus-original-article-buffer) | 1235 (set-buffer gnus-original-article-buffer) |
| 1236 (let ((buffer-read-only nil)) | 1236 (let ((buffer-read-only nil)) |
| 1237 (save-excursion | 1237 (save-excursion |
| 1238 (set-buffer gnus-summary-buffer) | 1238 (set-buffer gnus-summary-buffer) |
| 1239 (setq process-state | 1239 (setq process-state |
| 1240 (funcall process-function | 1240 (funcall process-function |
| 1241 gnus-original-article-buffer state))))) | 1241 gnus-original-article-buffer state))))) |
| 1242 | 1242 |
| 1243 (gnus-summary-remove-process-mark article) | 1243 (gnus-summary-remove-process-mark article) |
| 1244 | 1244 |
| 1245 ;; If this is the beginning of a decoded file, we push it | 1245 ;; If this is the beginning of a decoded file, we push it |
| 1246 ;; on to a list. | 1246 ;; on to a list. |
| 1247 (when (or (memq 'begin process-state) | 1247 (when (or (memq 'begin process-state) |
| 1248 (and (or (eq state 'first) | 1248 (and (or (eq state 'first) |
| 1249 (eq state 'first-and-last)) | 1249 (eq state 'first-and-last)) |
| 1250 (memq 'ok process-state))) | 1250 (memq 'ok process-state))) |
| 1251 (when has-been-begin | 1251 (when has-been-begin |
| 1252 ;; If there is a `result-file' here, that means that the | 1252 ;; If there is a `result-file' here, that means that the |
| 1253 ;; file was unsuccessfully decoded, so we delete it. | 1253 ;; file was unsuccessfully decoded, so we delete it. |
| 1254 (when (and result-file | 1254 (when (and result-file |
| 1255 (file-exists-p result-file) | 1255 (file-exists-p result-file) |
| 1256 (not gnus-uu-be-dangerous) | 1256 (not gnus-uu-be-dangerous) |
| 1257 (or (eq gnus-uu-be-dangerous t) | 1257 (or (eq gnus-uu-be-dangerous t) |
| 1258 (gnus-y-or-n-p | 1258 (gnus-y-or-n-p |
| 1259 (format "Delete unsuccessfully decoded file %s" | 1259 (format "Delete unsuccessfully decoded file %s" |
| 1290 ;; If this is the last article to be decoded, and | 1290 ;; If this is the last article to be decoded, and |
| 1291 ;; we still haven't reached the end, then we delete | 1291 ;; we still haven't reached the end, then we delete |
| 1292 ;; the partially decoded file. | 1292 ;; the partially decoded file. |
| 1293 (and (or (eq state 'last) (eq state 'first-and-last)) | 1293 (and (or (eq state 'last) (eq state 'first-and-last)) |
| 1294 (not (memq 'end process-state)) | 1294 (not (memq 'end process-state)) |
| 1295 result-file | 1295 result-file |
| 1296 (file-exists-p result-file) | 1296 (file-exists-p result-file) |
| 1297 (not gnus-uu-be-dangerous) | 1297 (not gnus-uu-be-dangerous) |
| 1298 (or (eq gnus-uu-be-dangerous t) | 1298 (or (eq gnus-uu-be-dangerous t) |
| 1299 (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file))) | 1299 (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file))) |
| 1300 (delete-file result-file)) | 1300 (delete-file result-file)) |
| 1301 | 1301 |
| 1302 ;; If this was a file of the wrong sort, then | 1302 ;; If this was a file of the wrong sort, then |
| 1303 (when (and (or (memq 'wrong-type process-state) | 1303 (when (and (or (memq 'wrong-type process-state) |
| 1304 (memq 'error process-state)) | 1304 (memq 'error process-state)) |
| 1305 gnus-uu-unmark-articles-not-decoded) | 1305 gnus-uu-unmark-articles-not-decoded) |
| 1306 (gnus-summary-tick-article article t)) | 1306 (gnus-summary-tick-article article t)) |
| 1307 | 1307 |
| 1353 (make-symbolic-link to-file file))))) | 1353 (make-symbolic-link to-file file))))) |
| 1354 | 1354 |
| 1355 (defun gnus-uu-part-number (article) | 1355 (defun gnus-uu-part-number (article) |
| 1356 (let* ((header (gnus-summary-article-header article)) | 1356 (let* ((header (gnus-summary-article-header article)) |
| 1357 (subject (and header (mail-header-subject header)))) | 1357 (subject (and header (mail-header-subject header)))) |
| 1358 (if (and subject | 1358 (if (and subject |
| 1359 (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) | 1359 (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) |
| 1360 (match-string 0 subject) | 1360 (match-string 0 subject) |
| 1361 ""))) | 1361 ""))) |
| 1362 | 1362 |
| 1363 (defun gnus-uu-uudecode-sentinel (process event) | 1363 (defun gnus-uu-uudecode-sentinel (process event) |
| 1366 (defun gnus-uu-uustrip-article (process-buffer in-state) | 1366 (defun gnus-uu-uustrip-article (process-buffer in-state) |
| 1367 ;; Uudecodes a file asynchronously. | 1367 ;; Uudecodes a file asynchronously. |
| 1368 (save-excursion | 1368 (save-excursion |
| 1369 (set-buffer process-buffer) | 1369 (set-buffer process-buffer) |
| 1370 (let ((state (list 'wrong-type)) | 1370 (let ((state (list 'wrong-type)) |
| 1371 process-connection-type case-fold-search buffer-read-only | 1371 process-connection-type case-fold-search buffer-read-only |
| 1372 files start-char) | 1372 files start-char) |
| 1373 (goto-char (point-min)) | 1373 (goto-char (point-min)) |
| 1374 | 1374 |
| 1375 ;; Deal with ^M at the end of the lines. | 1375 ;; Deal with ^M at the end of the lines. |
| 1376 (when gnus-uu-kill-carriage-return | 1376 (when gnus-uu-kill-carriage-return |
| 1387 | 1387 |
| 1388 (if (not (looking-at gnus-uu-begin-string)) | 1388 (if (not (looking-at gnus-uu-begin-string)) |
| 1389 (setq state (list 'middle)) | 1389 (setq state (list 'middle)) |
| 1390 ;; This is the beginning of an uuencoded article. | 1390 ;; This is the beginning of an uuencoded article. |
| 1391 ;; We replace certain characters that could make things messy. | 1391 ;; We replace certain characters that could make things messy. |
| 1392 (setq gnus-uu-file-name | 1392 (setq gnus-uu-file-name |
| 1393 (let ((nnheader-file-name-translation-alist | 1393 (let ((nnheader-file-name-translation-alist |
| 1394 '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) | 1394 '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) |
| 1395 (nnheader-translate-file-chars (match-string 1)))) | 1395 (nnheader-translate-file-chars (match-string 1)))) |
| 1396 (replace-match (concat "begin 644 " gnus-uu-file-name) t t) | 1396 (replace-match (concat "begin 644 " gnus-uu-file-name) t t) |
| 1397 | 1397 |
| 1412 (let ((cdir default-directory)) | 1412 (let ((cdir default-directory)) |
| 1413 (unwind-protect | 1413 (unwind-protect |
| 1414 (progn | 1414 (progn |
| 1415 (cd gnus-uu-work-dir) | 1415 (cd gnus-uu-work-dir) |
| 1416 (setq gnus-uu-uudecode-process | 1416 (setq gnus-uu-uudecode-process |
| 1417 (start-process | 1417 (start-process |
| 1418 "*uudecode*" | 1418 "*uudecode*" |
| 1419 (get-buffer-create gnus-uu-output-buffer-name) | 1419 (get-buffer-create gnus-uu-output-buffer-name) |
| 1420 shell-file-name shell-command-switch | 1420 shell-file-name shell-command-switch |
| 1421 (format "cd %s %s uudecode" gnus-uu-work-dir | 1421 (format "cd %s %s uudecode" gnus-uu-work-dir |
| 1422 gnus-shell-command-separator)))) | 1422 gnus-shell-command-separator)))) |
| 1423 (cd cdir))) | 1423 (cd cdir))) |
| 1424 (set-process-sentinel | 1424 (set-process-sentinel |
| 1425 gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) | 1425 gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) |
| 1426 (setq state (list 'begin)) | 1426 (setq state (list 'begin)) |
| 1427 (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) | 1427 (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) |
| 1428 | 1428 |
| 1429 ;; We look for the end of the thing to be decoded. | 1429 ;; We look for the end of the thing to be decoded. |
| 1430 (if (re-search-forward gnus-uu-end-string nil t) | 1430 (if (re-search-forward gnus-uu-end-string nil t) |
| 1431 (push 'end state) | 1431 (push 'end state) |
| 1432 (goto-char (point-max)) | 1432 (goto-char (point-max)) |
| 1433 (re-search-backward gnus-uu-body-line nil t)) | 1433 (re-search-backward gnus-uu-body-line nil t)) |
| 1434 | 1434 |
| 1435 (forward-line 1) | 1435 (forward-line 1) |
| 1436 | 1436 |
| 1437 (when gnus-uu-uudecode-process | 1437 (when gnus-uu-uudecode-process |
| 1438 (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) | 1438 (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) |
| 1439 ;; Try to correct mishandled uucode. | 1439 ;; Try to correct mishandled uucode. |
| 1442 | 1442 |
| 1443 ;; Send the text to the process. | 1443 ;; Send the text to the process. |
| 1444 (condition-case nil | 1444 (condition-case nil |
| 1445 (process-send-region | 1445 (process-send-region |
| 1446 gnus-uu-uudecode-process start-char (point)) | 1446 gnus-uu-uudecode-process start-char (point)) |
| 1447 (error | 1447 (error |
| 1448 (progn | 1448 (progn |
| 1449 (delete-process gnus-uu-uudecode-process) | 1449 (delete-process gnus-uu-uudecode-process) |
| 1450 (gnus-message 2 "gnus-uu: Couldn't uudecode") | 1450 (gnus-message 2 "gnus-uu: Couldn't uudecode") |
| 1451 (setq state (list 'wrong-type))))) | 1451 (setq state (list 'wrong-type))))) |
| 1452 | 1452 |
| 1453 (if (memq 'end state) | 1453 (if (memq 'end state) |
| 1477 (goto-char (point-min)) | 1477 (goto-char (point-min)) |
| 1478 (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) | 1478 (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) |
| 1479 (setq state (list 'wrong-type)) | 1479 (setq state (list 'wrong-type)) |
| 1480 (beginning-of-line) | 1480 (beginning-of-line) |
| 1481 (setq start-char (point)) | 1481 (setq start-char (point)) |
| 1482 (call-process-region | 1482 (call-process-region |
| 1483 start-char (point-max) shell-file-name nil | 1483 start-char (point-max) shell-file-name nil |
| 1484 (get-buffer-create gnus-uu-output-buffer-name) nil | 1484 (get-buffer-create gnus-uu-output-buffer-name) nil |
| 1485 shell-command-switch | 1485 shell-command-switch |
| 1486 (concat "cd " gnus-uu-work-dir " " | 1486 (concat "cd " gnus-uu-work-dir " " |
| 1487 gnus-shell-command-separator " sh")))) | 1487 gnus-shell-command-separator " sh")))) |
| 1488 state)) | 1488 state)) |
| 1489 | 1489 |
| 1490 ;; Returns the name of what the shar file is going to unpack. | 1490 ;; Returns the name of what the shar file is going to unpack. |
| 1491 (defun gnus-uu-find-name-in-shar () | 1491 (defun gnus-uu-find-name-in-shar () |
| 1502 ;; found, or the name of the command to run if such a rule is found. | 1502 ;; found, or the name of the command to run if such a rule is found. |
| 1503 (defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) | 1503 (defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) |
| 1504 (let ((action-list (copy-sequence file-action-list)) | 1504 (let ((action-list (copy-sequence file-action-list)) |
| 1505 (case-fold-search t) | 1505 (case-fold-search t) |
| 1506 rule action) | 1506 rule action) |
| 1507 (and | 1507 (and |
| 1508 (unless no-ignore | 1508 (unless no-ignore |
| 1509 (and (not | 1509 (and (not |
| 1510 (and gnus-uu-ignore-files-by-name | 1510 (and gnus-uu-ignore-files-by-name |
| 1511 (string-match gnus-uu-ignore-files-by-name file-name))) | 1511 (string-match gnus-uu-ignore-files-by-name file-name))) |
| 1512 (not | 1512 (not |
| 1513 (and gnus-uu-ignore-files-by-type | 1513 (and gnus-uu-ignore-files-by-type |
| 1514 (string-match gnus-uu-ignore-files-by-type | 1514 (string-match gnus-uu-ignore-files-by-type |
| 1515 (or (gnus-uu-choose-action | 1515 (or (gnus-uu-choose-action |
| 1516 file-name gnus-uu-ext-to-mime-list t) | 1516 file-name gnus-uu-ext-to-mime-list t) |
| 1517 "")))))) | 1517 "")))))) |
| 1518 (while (not (or (eq action-list ()) action)) | 1518 (while (not (or (eq action-list ()) action)) |
| 1519 (setq rule (car action-list)) | 1519 (setq rule (car action-list)) |
| 1520 (setq action-list (cdr action-list)) | 1520 (setq action-list (cdr action-list)) |
| 1524 | 1524 |
| 1525 (defun gnus-uu-treat-archive (file-path) | 1525 (defun gnus-uu-treat-archive (file-path) |
| 1526 ;; Unpacks an archive. Returns t if unpacking is successful. | 1526 ;; Unpacks an archive. Returns t if unpacking is successful. |
| 1527 (let ((did-unpack t) | 1527 (let ((did-unpack t) |
| 1528 action command dir) | 1528 action command dir) |
| 1529 (setq action (gnus-uu-choose-action | 1529 (setq action (gnus-uu-choose-action |
| 1530 file-path (append gnus-uu-user-archive-rules | 1530 file-path (append gnus-uu-user-archive-rules |
| 1531 (if gnus-uu-ignore-default-archive-rules | 1531 (if gnus-uu-ignore-default-archive-rules |
| 1532 nil | 1532 nil |
| 1533 gnus-uu-default-archive-rules)))) | 1533 gnus-uu-default-archive-rules)))) |
| 1534 | 1534 |
| 1547 (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) | 1547 (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) |
| 1548 (erase-buffer)) | 1548 (erase-buffer)) |
| 1549 | 1549 |
| 1550 (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) | 1550 (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) |
| 1551 | 1551 |
| 1552 (if (= 0 (call-process shell-file-name nil | 1552 (if (= 0 (call-process shell-file-name nil |
| 1553 (get-buffer-create gnus-uu-output-buffer-name) | 1553 (get-buffer-create gnus-uu-output-buffer-name) |
| 1554 nil shell-command-switch command)) | 1554 nil shell-command-switch command)) |
| 1555 (message "") | 1555 (message "") |
| 1556 (gnus-message 2 "Error during unpacking of archive") | 1556 (gnus-message 2 "Error during unpacking of archive") |
| 1557 (setq did-unpack nil)) | 1557 (setq did-unpack nil)) |
| 1570 (push file files)) | 1570 (push file files)) |
| 1571 (setq dirs (cdr dirs))) | 1571 (setq dirs (cdr dirs))) |
| 1572 files)) | 1572 files)) |
| 1573 | 1573 |
| 1574 (defun gnus-uu-unpack-files (files &optional ignore) | 1574 (defun gnus-uu-unpack-files (files &optional ignore) |
| 1575 ;; Go through FILES and look for files to unpack. | 1575 ;; Go through FILES and look for files to unpack. |
| 1576 (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) | 1576 (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) |
| 1577 (ofiles files) | 1577 (ofiles files) |
| 1578 file did-unpack) | 1578 file did-unpack) |
| 1579 (while files | 1579 (while files |
| 1580 (setq file (cdr (assq 'name (car files)))) | 1580 (setq file (cdr (assq 'name (car files)))) |
| 1592 (cons 'original file)) | 1592 (cons 'original file)) |
| 1593 ofiles)) | 1593 ofiles)) |
| 1594 (setq nfiles (cdr nfiles))) | 1594 (setq nfiles (cdr nfiles))) |
| 1595 (setq totfiles newfiles))) | 1595 (setq totfiles newfiles))) |
| 1596 (setq files (cdr files))) | 1596 (setq files (cdr files))) |
| 1597 (if did-unpack | 1597 (if did-unpack |
| 1598 (gnus-uu-unpack-files ofiles (append did-unpack ignore)) | 1598 (gnus-uu-unpack-files ofiles (append did-unpack ignore)) |
| 1599 ofiles))) | 1599 ofiles))) |
| 1600 | 1600 |
| 1601 (defun gnus-uu-ls-r (dir) | 1601 (defun gnus-uu-ls-r (dir) |
| 1602 (let* ((files (gnus-uu-directory-files dir t)) | 1602 (let* ((files (gnus-uu-directory-files dir t)) |
| 1634 (while (not (eobp)) | 1634 (while (not (eobp)) |
| 1635 (progn | 1635 (progn |
| 1636 (when (looking-at "\n") | 1636 (when (looking-at "\n") |
| 1637 (replace-match "")) | 1637 (replace-match "")) |
| 1638 (forward-line 1)))) | 1638 (forward-line 1)))) |
| 1639 | 1639 |
| 1640 (while (not (eobp)) | 1640 (while (not (eobp)) |
| 1641 (if (looking-at (concat gnus-uu-begin-string "\\|" | 1641 (if (looking-at (concat gnus-uu-begin-string "\\|" |
| 1642 gnus-uu-end-string)) | 1642 gnus-uu-end-string)) |
| 1643 () | 1643 () |
| 1644 (when (not found) | 1644 (when (not found) |
| 1645 (beginning-of-line) | 1645 (beginning-of-line) |
| 1646 (setq beg (point)) | 1646 (setq beg (point)) |
| 1663 (if (file-exists-p (cdr entry)) | 1663 (if (file-exists-p (cdr entry)) |
| 1664 (setq gnus-uu-work-dir (cdr entry)) | 1664 (setq gnus-uu-work-dir (cdr entry)) |
| 1665 (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) | 1665 (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) |
| 1666 nil))) | 1666 nil))) |
| 1667 t | 1667 t |
| 1668 (setq gnus-uu-tmp-dir (file-name-as-directory | 1668 (setq gnus-uu-tmp-dir (file-name-as-directory |
| 1669 (expand-file-name gnus-uu-tmp-dir))) | 1669 (expand-file-name gnus-uu-tmp-dir))) |
| 1670 (if (not (file-directory-p gnus-uu-tmp-dir)) | 1670 (if (not (file-directory-p gnus-uu-tmp-dir)) |
| 1671 (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) | 1671 (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) |
| 1672 (when (not (file-writable-p gnus-uu-tmp-dir)) | 1672 (when (not (file-writable-p gnus-uu-tmp-dir)) |
| 1673 (error "Temp directory %s can't be written to" | 1673 (error "Temp directory %s can't be written to" |
| 1674 gnus-uu-tmp-dir))) | 1674 gnus-uu-tmp-dir))) |
| 1675 | 1675 |
| 1676 (setq gnus-uu-work-dir | 1676 (setq gnus-uu-work-dir |
| 1677 (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) | 1677 (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) |
| 1678 (gnus-make-directory gnus-uu-work-dir) | 1678 (gnus-make-directory gnus-uu-work-dir) |
| 1679 (set-file-modes gnus-uu-work-dir 448) | 1679 (set-file-modes gnus-uu-work-dir 448) |
| 1680 (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) | 1680 (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) |
| 1681 (push (cons gnus-newsgroup-name gnus-uu-work-dir) | 1681 (push (cons gnus-newsgroup-name gnus-uu-work-dir) |
| 1748 ;; the encoding wasn't successful. | 1748 ;; the encoding wasn't successful. |
| 1749 (defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode | 1749 (defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode |
| 1750 "Function used for encoding binary files. | 1750 "Function used for encoding binary files. |
| 1751 There are three functions supplied with gnus-uu for encoding files: | 1751 There are three functions supplied with gnus-uu for encoding files: |
| 1752 `gnus-uu-post-encode-uuencode', which does straight uuencoding; | 1752 `gnus-uu-post-encode-uuencode', which does straight uuencoding; |
| 1753 `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME | 1753 `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME |
| 1754 headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with | 1754 headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with |
| 1755 uuencode and adds MIME headers." | 1755 uuencode and adds MIME headers." |
| 1756 :group 'gnus-extract-post | 1756 :group 'gnus-extract-post |
| 1757 :type '(radio (function-item gnus-uu-post-encode-uuencode) | 1757 :type '(radio (function-item gnus-uu-post-encode-uuencode) |
| 1758 (function-item gnus-uu-post-encode-mime) | 1758 (function-item gnus-uu-post-encode-mime) |
| 1759 (function-item gnus-uu-post-encode-mime-uuencode) | 1759 (function-item gnus-uu-post-encode-mime-uuencode) |
| 1775 | 1775 |
| 1776 (defcustom gnus-uu-post-threaded nil | 1776 (defcustom gnus-uu-post-threaded nil |
| 1777 "Non-nil means that gnus-uu will post the encoded file in a thread. | 1777 "Non-nil means that gnus-uu will post the encoded file in a thread. |
| 1778 This may not be smart, as no other decoder I have seen are able to | 1778 This may not be smart, as no other decoder I have seen are able to |
| 1779 follow threads when collecting uuencoded articles. (Well, I have seen | 1779 follow threads when collecting uuencoded articles. (Well, I have seen |
| 1780 one package that does that - gnus-uu, but somehow, I don't think that | 1780 one package that does that - gnus-uu, but somehow, I don't think that |
| 1781 counts...) Default is nil." | 1781 counts...) Default is nil." |
| 1782 :group 'gnus-extract-post | 1782 :group 'gnus-extract-post |
| 1783 :type 'boolean) | 1783 :type 'boolean) |
| 1784 | 1784 |
| 1785 (defcustom gnus-uu-post-separate-description t | 1785 (defcustom gnus-uu-post-separate-description t |
| 1786 "Non-nil means that the description will be posted in a separate article. | 1786 "Non-nil means that the description will be posted in a separate article. |
| 1787 The first article will typically be numbered (0/x). If this variable | 1787 The first article will typically be numbered (0/x). If this variable |
| 1788 is nil, the description the user enters will be included at the | 1788 is nil, the description the user enters will be included at the |
| 1789 beginning of the first article, which will be numbered (1/x). Default | 1789 beginning of the first article, which will be numbered (1/x). Default |
| 1790 is t." | 1790 is t." |
| 1791 :group 'gnus-extract-post | 1791 :group 'gnus-extract-post |
| 1792 :type 'boolean) | 1792 :type 'boolean) |
| 1793 | 1793 |
| 1794 (defvar gnus-uu-post-binary-separator "--binary follows this line--") | 1794 (defvar gnus-uu-post-binary-separator "--binary follows this line--") |
| 1807 (use-local-map (copy-keymap (current-local-map))) | 1807 (use-local-map (copy-keymap (current-local-map))) |
| 1808 (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) | 1808 (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) |
| 1809 (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) | 1809 (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) |
| 1810 (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) | 1810 (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) |
| 1811 (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) | 1811 (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) |
| 1812 | 1812 |
| 1813 (when gnus-uu-post-include-before-composing | 1813 (when gnus-uu-post-include-before-composing |
| 1814 (save-excursion (setq gnus-uu-post-inserted-file-name | 1814 (save-excursion (setq gnus-uu-post-inserted-file-name |
| 1815 (gnus-uu-post-insert-binary))))) | 1815 (gnus-uu-post-insert-binary))))) |
| 1816 | 1816 |
| 1817 (defun gnus-uu-post-insert-binary-in-article () | 1817 (defun gnus-uu-post-insert-binary-in-article () |
| 1818 "Inserts an encoded file in the buffer. | 1818 "Inserts an encoded file in the buffer. |
| 1819 The user will be asked for a file name." | 1819 The user will be asked for a file name." |
| 1820 (interactive) | 1820 (interactive) |
| 1821 (save-excursion | 1821 (save-excursion |
| 1822 (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) | 1822 (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) |
| 1823 | 1823 |
| 1824 ;; Encodes with uuencode and substitutes all spaces with backticks. | 1824 ;; Encodes with uuencode and substitutes all spaces with backticks. |
| 1825 (defun gnus-uu-post-encode-uuencode (path file-name) | 1825 (defun gnus-uu-post-encode-uuencode (path file-name) |
| 1826 (when (gnus-uu-post-encode-file "uuencode" path file-name) | 1826 (when (gnus-uu-post-encode-file "uuencode" path file-name) |
| 1843 t)) | 1843 t)) |
| 1844 | 1844 |
| 1845 ;; Adds MIME headers. | 1845 ;; Adds MIME headers. |
| 1846 (defun gnus-uu-post-make-mime (file-name encoding) | 1846 (defun gnus-uu-post-make-mime (file-name encoding) |
| 1847 (goto-char (point-min)) | 1847 (goto-char (point-min)) |
| 1848 (insert (format "Content-Type: %s; name=\"%s\"\n" | 1848 (insert (format "Content-Type: %s; name=\"%s\"\n" |
| 1849 (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) | 1849 (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) |
| 1850 file-name)) | 1850 file-name)) |
| 1851 (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) | 1851 (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) |
| 1852 (save-restriction | 1852 (save-restriction |
| 1853 (set-buffer gnus-message-buffer) | 1853 (set-buffer gnus-message-buffer) |
| 1861 (widen))) | 1861 (widen))) |
| 1862 | 1862 |
| 1863 ;; Encodes a file PATH with COMMAND, leaving the result in the | 1863 ;; Encodes a file PATH with COMMAND, leaving the result in the |
| 1864 ;; current buffer. | 1864 ;; current buffer. |
| 1865 (defun gnus-uu-post-encode-file (command path file-name) | 1865 (defun gnus-uu-post-encode-file (command path file-name) |
| 1866 (= 0 (call-process shell-file-name nil t nil shell-command-switch | 1866 (= 0 (call-process shell-file-name nil t nil shell-command-switch |
| 1867 (format "%s %s %s" command path file-name)))) | 1867 (format "%s %s %s" command path file-name)))) |
| 1868 | 1868 |
| 1869 (defun gnus-uu-post-news-inews () | 1869 (defun gnus-uu-post-news-inews () |
| 1870 "Posts the composed news article and encoded file. | 1870 "Posts the composed news article and encoded file. |
| 1871 If no file has been included, the user will be asked for a file." | 1871 If no file has been included, the user will be asked for a file." |
| 1874 (let (file-name) | 1874 (let (file-name) |
| 1875 | 1875 |
| 1876 (if gnus-uu-post-inserted-file-name | 1876 (if gnus-uu-post-inserted-file-name |
| 1877 (setq file-name gnus-uu-post-inserted-file-name) | 1877 (setq file-name gnus-uu-post-inserted-file-name) |
| 1878 (setq file-name (gnus-uu-post-insert-binary))) | 1878 (setq file-name (gnus-uu-post-insert-binary))) |
| 1879 | 1879 |
| 1880 (if gnus-uu-post-threaded | 1880 (if gnus-uu-post-threaded |
| 1881 (let ((message-required-news-headers | 1881 (let ((message-required-news-headers |
| 1882 (if (memq 'Message-ID message-required-news-headers) | 1882 (if (memq 'Message-ID message-required-news-headers) |
| 1883 message-required-news-headers | 1883 message-required-news-headers |
| 1884 (cons 'Message-ID message-required-news-headers))) | 1884 (cons 'Message-ID message-required-news-headers))) |
| 1885 gnus-inews-article-hook) | 1885 gnus-inews-article-hook) |
| 1886 | 1886 |
| 1890 (push | 1890 (push |
| 1891 '(lambda () | 1891 '(lambda () |
| 1892 (save-excursion | 1892 (save-excursion |
| 1893 (goto-char (point-min)) | 1893 (goto-char (point-min)) |
| 1894 (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) | 1894 (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) |
| 1895 (setq gnus-uu-post-message-id | 1895 (setq gnus-uu-post-message-id |
| 1896 (buffer-substring | 1896 (buffer-substring |
| 1897 (match-beginning 1) (match-end 1))) | 1897 (match-beginning 1) (match-end 1))) |
| 1898 (setq gnus-uu-post-message-id nil)))) | 1898 (setq gnus-uu-post-message-id nil)))) |
| 1899 gnus-inews-article-hook) | 1899 gnus-inews-article-hook) |
| 1900 (gnus-uu-post-encoded file-name t)) | 1900 (gnus-uu-post-encoded file-name t)) |
| 1901 (gnus-uu-post-encoded file-name nil))) | 1901 (gnus-uu-post-encoded file-name nil))) |
| 1902 (setq gnus-uu-post-inserted-file-name nil) | 1902 (setq gnus-uu-post-inserted-file-name nil) |
| 1903 (when gnus-uu-winconf-post-news | 1903 (when gnus-uu-winconf-post-news |
| 1904 (set-window-configuration gnus-uu-winconf-post-news))) | 1904 (set-window-configuration gnus-uu-winconf-post-news))) |
| 1905 | 1905 |
| 1906 ;; Asks for a file to encode, encodes it and inserts the result in | 1906 ;; Asks for a file to encode, encodes it and inserts the result in |
| 1907 ;; the current buffer. Returns the file name the user gave. | 1907 ;; the current buffer. Returns the file name the user gave. |
| 1908 (defun gnus-uu-post-insert-binary () | 1908 (defun gnus-uu-post-insert-binary () |
| 1909 (let ((uuencode-buffer-name "*uuencode buffer*") | 1909 (let ((uuencode-buffer-name "*uuencode buffer*") |
| 1910 file-path uubuf file-name) | 1910 file-path uubuf file-name) |
| 1911 | 1911 |
| 1912 (setq file-path (read-file-name | 1912 (setq file-path (read-file-name |
| 1913 "What file do you want to encode? ")) | 1913 "What file do you want to encode? ")) |
| 1914 (when (not (file-exists-p file-path)) | 1914 (when (not (file-exists-p file-path)) |
| 1915 (error "%s: No such file" file-path)) | 1915 (error "%s: No such file" file-path)) |
| 1916 | 1916 |
| 1917 (goto-char (point-max)) | 1917 (goto-char (point-max)) |
| 1918 (insert (format "\n%s\n" gnus-uu-post-binary-separator)) | 1918 (insert (format "\n%s\n" gnus-uu-post-binary-separator)) |
| 1919 | 1919 |
| 1920 (when (string-match "^~/" file-path) | 1920 (when (string-match "^~/" file-path) |
| 1921 (setq file-path (concat "$HOME" (substring file-path 1)))) | 1921 (setq file-path (concat "$HOME" (substring file-path 1)))) |
| 1922 (if (string-match "/[^/]*$" file-path) | 1922 (if (string-match "/[^/]*$" file-path) |
| 1923 (setq file-name (substring file-path (1+ (match-beginning 0)))) | 1923 (setq file-name (substring file-path (1+ (match-beginning 0)))) |
| 1924 (setq file-name file-path)) | 1924 (setq file-name file-path)) |
| 1925 | 1925 |
| 1926 (unwind-protect | 1926 (unwind-protect |
| 1927 (if (save-excursion | 1927 (if (save-excursion |
| 1928 (set-buffer (setq uubuf | 1928 (set-buffer (setq uubuf |
| 1929 (get-buffer-create uuencode-buffer-name))) | 1929 (get-buffer-create uuencode-buffer-name))) |
| 1930 (erase-buffer) | 1930 (erase-buffer) |
| 1931 (funcall gnus-uu-post-encode-method file-path file-name)) | 1931 (funcall gnus-uu-post-encode-method file-path file-name)) |
| 1932 (insert-buffer-substring uubuf) | 1932 (insert-buffer-substring uubuf) |
| 1933 (error "Encoding unsuccessful")) | 1933 (error "Encoding unsuccessful")) |
| 1944 beg-line minlen buf post-buf whole-len beg-binary end-binary) | 1944 beg-line minlen buf post-buf whole-len beg-binary end-binary) |
| 1945 | 1945 |
| 1946 (setq post-buf (current-buffer)) | 1946 (setq post-buf (current-buffer)) |
| 1947 | 1947 |
| 1948 (goto-char (point-min)) | 1948 (goto-char (point-min)) |
| 1949 (when (not (re-search-forward | 1949 (when (not (re-search-forward |
| 1950 (if gnus-uu-post-separate-description | 1950 (if gnus-uu-post-separate-description |
| 1951 (concat "^" (regexp-quote gnus-uu-post-binary-separator) | 1951 (concat "^" (regexp-quote gnus-uu-post-binary-separator) |
| 1952 "$") | 1952 "$") |
| 1953 (concat "^" (regexp-quote mail-header-separator) "$")) | 1953 (concat "^" (regexp-quote mail-header-separator) "$")) |
| 1954 nil t)) | 1954 nil t)) |
| 1955 (error "Internal error: No binary/header separator")) | 1955 (error "Internal error: No binary/header separator")) |
| 1956 (beginning-of-line) | 1956 (beginning-of-line) |
| 1957 (forward-line 1) | 1957 (forward-line 1) |
| 1958 (setq beg-binary (point)) | 1958 (setq beg-binary (point)) |
| 1959 (setq end-binary (point-max)) | 1959 (setq end-binary (point-max)) |
| 1960 | 1960 |
| 1961 (save-excursion | 1961 (save-excursion |
| 1962 (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) | 1962 (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) |
| 1963 (erase-buffer) | 1963 (erase-buffer) |
| 1964 (insert-buffer-substring post-buf beg-binary end-binary) | 1964 (insert-buffer-substring post-buf beg-binary end-binary) |
| 1965 (goto-char (point-min)) | 1965 (goto-char (point-min)) |
| 1966 (setq length (count-lines 1 (point-max))) | 1966 (setq length (count-lines 1 (point-max))) |
| 1971 (when gnus-uu-post-separate-description | 1971 (when gnus-uu-post-separate-description |
| 1972 (forward-line -1)) | 1972 (forward-line -1)) |
| 1973 (kill-region (point) (point-max)) | 1973 (kill-region (point) (point-max)) |
| 1974 | 1974 |
| 1975 (goto-char (point-min)) | 1975 (goto-char (point-min)) |
| 1976 (re-search-forward | 1976 (re-search-forward |
| 1977 (concat "^" (regexp-quote mail-header-separator) "$") nil t) | 1977 (concat "^" (regexp-quote mail-header-separator) "$") nil t) |
| 1978 (beginning-of-line) | 1978 (beginning-of-line) |
| 1979 (setq header (buffer-substring 1 (point))) | 1979 (setq header (buffer-substring 1 (point))) |
| 1980 | 1980 |
| 1981 (goto-char (point-min)) | 1981 (goto-char (point-min)) |
| 1998 (insert separator) | 1998 (insert separator) |
| 1999 (setq whole-len | 1999 (setq whole-len |
| 2000 (- 62 (length (format top-string "" file-name i parts "")))) | 2000 (- 62 (length (format top-string "" file-name i parts "")))) |
| 2001 (when (> 1 (setq minlen (/ whole-len 2))) | 2001 (when (> 1 (setq minlen (/ whole-len 2))) |
| 2002 (setq minlen 1)) | 2002 (setq minlen 1)) |
| 2003 (setq | 2003 (setq |
| 2004 beg-line | 2004 beg-line |
| 2005 (format top-string | 2005 (format top-string |
| 2006 (make-string minlen ?-) | 2006 (make-string minlen ?-) |
| 2007 file-name i parts | 2007 file-name i parts |
| 2008 (make-string | 2008 (make-string |
| 2009 (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) | 2009 (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) |
| 2010 | 2010 |
| 2011 (goto-char (point-min)) | 2011 (goto-char (point-min)) |
| 2012 (if (not (re-search-forward "^Subject: " nil t)) | 2012 (if (not (re-search-forward "^Subject: " nil t)) |
| 2013 () | 2013 () |
| 2016 (end-of-line) | 2016 (end-of-line) |
| 2017 (insert (format " (%d/%d)" i parts))) | 2017 (insert (format " (%d/%d)" i parts))) |
| 2018 (when (or (and (= i 2) gnus-uu-post-separate-description) | 2018 (when (or (and (= i 2) gnus-uu-post-separate-description) |
| 2019 (and (= i 1) (not gnus-uu-post-separate-description))) | 2019 (and (= i 1) (not gnus-uu-post-separate-description))) |
| 2020 (replace-match "Subject: Re: ")))) | 2020 (replace-match "Subject: Re: ")))) |
| 2021 | 2021 |
| 2022 (goto-char (point-max)) | 2022 (goto-char (point-max)) |
| 2023 (save-excursion | 2023 (save-excursion |
| 2024 (set-buffer uubuf) | 2024 (set-buffer uubuf) |
| 2025 (goto-char beg) | 2025 (goto-char beg) |
| 2026 (if (= i parts) | 2026 (if (= i parts) |
| 2037 (goto-char (point-min)) | 2037 (goto-char (point-min)) |
| 2038 (re-search-forward | 2038 (re-search-forward |
| 2039 (concat "^" (regexp-quote mail-header-separator) "$") nil t) | 2039 (concat "^" (regexp-quote mail-header-separator) "$") nil t) |
| 2040 (beginning-of-line) | 2040 (beginning-of-line) |
| 2041 (forward-line 2) | 2041 (forward-line 2) |
| 2042 (when (re-search-forward | 2042 (when (re-search-forward |
| 2043 (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") | 2043 (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") |
| 2044 nil t) | 2044 nil t) |
| 2045 (replace-match "") | 2045 (replace-match "") |
| 2046 (forward-line 1)) | 2046 (forward-line 1)) |
| 2047 (insert beg-line) | 2047 (insert beg-line) |