Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-art.el @ 42:8b8b7f3559a2 r19-15b104

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b104
author cvs
date Mon, 13 Aug 2007 08:54:51 +0200
parents c53a95d3c46d
children
comparison
equal deleted inserted replaced
41:5d6df4963a99 42:8b8b7f3559a2
321 LAST-FILE." 321 LAST-FILE."
322 :group 'gnus-article-saving 322 :group 'gnus-article-saving
323 :type 'function) 323 :type 'function)
324 324
325 (defcustom gnus-split-methods 325 (defcustom gnus-split-methods
326 '((gnus-article-archive-name)) 326 '((gnus-article-archive-name)
327 (gnus-article-nndoc-name))
327 "Variable used to suggest where articles are to be saved. 328 "Variable used to suggest where articles are to be saved.
328 For instance, if you would like to save articles related to Gnus in 329 For instance, if you would like to save articles related to Gnus in
329 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", 330 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
330 you could set this variable to something like: 331 you could set this variable to something like:
331 332
1391 (when (eq gnus-prompt-before-saving t) 1392 (when (eq gnus-prompt-before-saving t)
1392 num))) ; Magic 1393 num))) ; Magic
1393 (set-buffer gnus-summary-buffer) 1394 (set-buffer gnus-summary-buffer)
1394 (funcall gnus-default-article-saver filename))))) 1395 (funcall gnus-default-article-saver filename)))))
1395 1396
1396 (defun gnus-read-save-file-name (prompt default-name &optional filename) 1397 (defun gnus-read-save-file-name (prompt &optional filename
1397 (cond 1398 function group headers variable)
1398 ((eq filename 'default) 1399 (let ((default-name (funcall function group headers
1399 default-name) 1400 (symbol-value variable)))
1400 (filename filename) 1401 result)
1401 (t 1402 (setq
1402 (let* ((split-name (gnus-get-split-value gnus-split-methods)) 1403 result
1403 (prompt 1404 (cond
1404 (format prompt (if (and gnus-number-of-articles-to-be-saved 1405 ((eq filename 'default)
1405 (> gnus-number-of-articles-to-be-saved 1)) 1406 default-name)
1406 (format "these %d articles" 1407 (filename filename)
1407 gnus-number-of-articles-to-be-saved) 1408 (t
1408 "this article"))) 1409 (let* ((split-name (gnus-get-split-value gnus-split-methods))
1409 (file 1410 (prompt
1410 ;; Let the split methods have their say. 1411 (format prompt
1411 (cond 1412 (if (and gnus-number-of-articles-to-be-saved
1412 ;; No split name was found. 1413 (> gnus-number-of-articles-to-be-saved 1))
1413 ((null split-name) 1414 (format "these %d articles"
1414 (read-file-name 1415 gnus-number-of-articles-to-be-saved)
1415 (concat prompt " (default " 1416 "this article")))
1416 (file-name-nondirectory default-name) ") ") 1417 (file
1417 (file-name-directory default-name) 1418 ;; Let the split methods have their say.
1418 default-name)) 1419 (cond
1419 ;; A single split name was found 1420 ;; No split name was found.
1420 ((= 1 (length split-name)) 1421 ((null split-name)
1421 (let* ((name (car split-name)) 1422 (read-file-name
1422 (dir (cond ((file-directory-p name) 1423 (concat prompt " (default "
1423 (file-name-as-directory name)) 1424 (file-name-nondirectory default-name) ") ")
1424 ((file-exists-p name) name) 1425 (file-name-directory default-name)
1425 (t gnus-article-save-directory)))) 1426 default-name))
1426 (read-file-name 1427 ;; A single group name is returned.
1427 (concat prompt " (default " name ") ") 1428 ((stringp split-name)
1428 dir name))) 1429 (setq default-name
1429 ;; A list of splits was found. 1430 (funcall function split-name headers
1430 (t 1431 (symbol-value variable)))
1431 (setq split-name (nreverse split-name)) 1432 (read-file-name
1432 (let (result) 1433 (concat prompt " (default "
1433 (let ((file-name-history (nconc split-name file-name-history))) 1434 (file-name-nondirectory default-name) ") ")
1434 (setq result 1435 (file-name-directory default-name)
1435 (expand-file-name 1436 default-name))
1436 (read-file-name 1437 ;; A single split name was found
1437 (concat prompt " (`M-p' for defaults) ") 1438 ((= 1 (length split-name))
1438 gnus-article-save-directory 1439 (let* ((name (car split-name))
1439 (car split-name)) 1440 (dir (cond ((file-directory-p name)
1440 gnus-article-save-directory))) 1441 (file-name-as-directory name))
1441 (car (push result file-name-history))))))) 1442 ((file-exists-p name) name)
1442 ;; Create the directory. 1443 (t gnus-article-save-directory))))
1443 (gnus-make-directory (file-name-directory file)) 1444 (read-file-name
1444 ;; If we have read a directory, we append the default file name. 1445 (concat prompt " (default " name ") ")
1445 (when (file-directory-p file) 1446 dir name)))
1446 (setq file (concat (file-name-as-directory file) 1447 ;; A list of splits was found.
1447 (file-name-nondirectory default-name)))) 1448 (t
1448 ;; Possibly translate some characters. 1449 (setq split-name (nreverse split-name))
1449 (nnheader-translate-file-chars file))))) 1450 (let (result)
1451 (let ((file-name-history
1452 (nconc split-name file-name-history)))
1453 (setq result
1454 (expand-file-name
1455 (read-file-name
1456 (concat prompt " (`M-p' for defaults) ")
1457 gnus-article-save-directory
1458 (car split-name))
1459 gnus-article-save-directory)))
1460 (car (push result file-name-history)))))))
1461 ;; Create the directory.
1462 (gnus-make-directory (file-name-directory file))
1463 ;; If we have read a directory, we append the default file name.
1464 (when (file-directory-p file)
1465 (setq file (concat (file-name-as-directory file)
1466 (file-name-nondirectory default-name))))
1467 ;; Possibly translate some characters.
1468 (nnheader-translate-file-chars file)))))
1469 (gnus-make-directory (file-name-directory result))
1470 (set variable result)))
1450 1471
1451 (defun gnus-article-archive-name (group) 1472 (defun gnus-article-archive-name (group)
1452 "Return the first instance of an \"Archive-name\" in the current buffer." 1473 "Return the first instance of an \"Archive-name\" in the current buffer."
1453 (let ((case-fold-search t)) 1474 (let ((case-fold-search t))
1454 (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) 1475 (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
1455 (nnheader-concat gnus-article-save-directory 1476 (nnheader-concat gnus-article-save-directory
1456 (match-string 1))))) 1477 (match-string 1)))))
1457 1478
1479 (defun gnus-article-nndoc-name (group)
1480 "If GROUP is an nndoc group, return the name of the parent group."
1481 (when (eq (car (gnus-find-method-for-group group)) 'nndoc)
1482 (gnus-group-get-parameter group 'save-article-group)))
1483
1458 (defun gnus-summary-save-in-rmail (&optional filename) 1484 (defun gnus-summary-save-in-rmail (&optional filename)
1459 "Append this article to Rmail file. 1485 "Append this article to Rmail file.
1460 Optional argument FILENAME specifies file name. 1486 Optional argument FILENAME specifies file name.
1461 Directory to save to is default to `gnus-article-save-directory'." 1487 Directory to save to is default to `gnus-article-save-directory'."
1462 (interactive) 1488 (interactive)
1463 (gnus-set-global-variables) 1489 (gnus-set-global-variables)
1464 (let ((default-name 1490 (setq filename (gnus-read-save-file-name
1465 (funcall gnus-rmail-save-name gnus-newsgroup-name 1491 "Save %s in rmail file:" filename
1466 gnus-current-headers gnus-newsgroup-last-rmail))) 1492 gnus-rmail-save-name gnus-newsgroup-name
1467 (setq filename (gnus-read-save-file-name 1493 gnus-current-headers 'gnus-newsgroup-last-rmail))
1468 "Save %s in rmail file:" default-name filename)) 1494 (gnus-eval-in-buffer-window gnus-save-article-buffer
1469 (gnus-make-directory (file-name-directory filename)) 1495 (save-excursion
1470 (gnus-eval-in-buffer-window gnus-save-article-buffer 1496 (save-restriction
1471 (save-excursion 1497 (widen)
1472 (save-restriction 1498 (gnus-output-to-rmail filename)))))
1473 (widen)
1474 (gnus-output-to-rmail filename))))
1475 ;; Remember the directory name to save articles
1476 (setq gnus-newsgroup-last-rmail filename)))
1477 1499
1478 (defun gnus-summary-save-in-mail (&optional filename) 1500 (defun gnus-summary-save-in-mail (&optional filename)
1479 "Append this article to Unix mail file. 1501 "Append this article to Unix mail file.
1480 Optional argument FILENAME specifies file name. 1502 Optional argument FILENAME specifies file name.
1481 Directory to save to is default to `gnus-article-save-directory'." 1503 Directory to save to is default to `gnus-article-save-directory'."
1482 (interactive) 1504 (interactive)
1483 (gnus-set-global-variables) 1505 (gnus-set-global-variables)
1484 (let ((default-name 1506 (setq filename (gnus-read-save-file-name
1485 (funcall gnus-mail-save-name gnus-newsgroup-name 1507 "Save %s in Unix mail file:" filename
1486 gnus-current-headers gnus-newsgroup-last-mail))) 1508 gnus-mail-save-name gnus-newsgroup-name
1487 (setq filename (gnus-read-save-file-name 1509 gnus-current-headers 'gnus-newsgroup-last-mail))
1488 "Save %s in Unix mail file:" default-name filename)) 1510 (gnus-eval-in-buffer-window gnus-save-article-buffer
1489 (setq filename 1511 (save-excursion
1490 (expand-file-name filename 1512 (save-restriction
1491 (and default-name 1513 (widen)
1492 (file-name-directory default-name)))) 1514 (if (and (file-readable-p filename)
1493 (gnus-make-directory (file-name-directory filename)) 1515 (mail-file-babyl-p filename))
1494 (gnus-eval-in-buffer-window gnus-save-article-buffer 1516 (gnus-output-to-rmail filename t)
1495 (save-excursion 1517 (gnus-output-to-mail filename))))))
1496 (save-restriction
1497 (widen)
1498 (if (and (file-readable-p filename)
1499 (mail-file-babyl-p filename))
1500 (gnus-output-to-rmail filename t)
1501 (gnus-output-to-mail filename)))))
1502 ;; Remember the directory name to save articles.
1503 (setq gnus-newsgroup-last-mail filename)))
1504 1518
1505 (defun gnus-summary-save-in-file (&optional filename overwrite) 1519 (defun gnus-summary-save-in-file (&optional filename overwrite)
1506 "Append this article to file. 1520 "Append this article to file.
1507 Optional argument FILENAME specifies file name. 1521 Optional argument FILENAME specifies file name.
1508 Directory to save to is default to `gnus-article-save-directory'." 1522 Directory to save to is default to `gnus-article-save-directory'."
1509 (interactive) 1523 (interactive)
1510 (gnus-set-global-variables) 1524 (gnus-set-global-variables)
1511 (let ((default-name 1525 (setq filename (gnus-read-save-file-name
1512 (funcall gnus-file-save-name gnus-newsgroup-name 1526 "Save %s in file:" filename
1513 gnus-current-headers gnus-newsgroup-last-file))) 1527 gnus-file-save-name gnus-newsgroup-name
1514 (setq filename (gnus-read-save-file-name 1528 gnus-current-headers 'gnus-newsgroup-last-file))
1515 "Save %s in file:" default-name filename)) 1529 (gnus-eval-in-buffer-window gnus-save-article-buffer
1516 (gnus-make-directory (file-name-directory filename)) 1530 (save-excursion
1517 (gnus-eval-in-buffer-window gnus-save-article-buffer 1531 (save-restriction
1518 (save-excursion 1532 (widen)
1519 (save-restriction 1533 (when (and overwrite
1520 (widen) 1534 (file-exists-p filename))
1521 (when (and overwrite 1535 (delete-file filename))
1522 (file-exists-p filename)) 1536 (gnus-output-to-file filename)))))
1523 (delete-file filename))
1524 (gnus-output-to-file filename))))
1525 ;; Remember the directory name to save articles.
1526 (setq gnus-newsgroup-last-file filename)))
1527 1537
1528 (defun gnus-summary-write-to-file (&optional filename) 1538 (defun gnus-summary-write-to-file (&optional filename)
1529 "Write this article to a file. 1539 "Write this article to a file.
1530 Optional argument FILENAME specifies file name. 1540 Optional argument FILENAME specifies file name.
1531 The directory to save in defaults to `gnus-article-save-directory'." 1541 The directory to save in defaults to `gnus-article-save-directory'."
1536 "Append this article body to a file. 1546 "Append this article body to a file.
1537 Optional argument FILENAME specifies file name. 1547 Optional argument FILENAME specifies file name.
1538 The directory to save in defaults to `gnus-article-save-directory'." 1548 The directory to save in defaults to `gnus-article-save-directory'."
1539 (interactive) 1549 (interactive)
1540 (gnus-set-global-variables) 1550 (gnus-set-global-variables)
1541 (let ((default-name 1551 (setq filename (gnus-read-save-file-name
1542 (funcall gnus-file-save-name gnus-newsgroup-name 1552 "Save %s body in file:" filename
1543 gnus-current-headers gnus-newsgroup-last-file))) 1553 gnus-file-save-name gnus-newsgroup-name
1544 (setq filename (gnus-read-save-file-name 1554 gnus-current-headers 'gnus-newsgroup-last-file))
1545 "Save %s body in file:" default-name filename)) 1555 (gnus-eval-in-buffer-window gnus-save-article-buffer
1546 (gnus-make-directory (file-name-directory filename)) 1556 (save-excursion
1547 (gnus-eval-in-buffer-window gnus-save-article-buffer 1557 (save-restriction
1548 (save-excursion 1558 (widen)
1549 (save-restriction 1559 (goto-char (point-min))
1550 (widen) 1560 (when (search-forward "\n\n" nil t)
1551 (goto-char (point-min)) 1561 (narrow-to-region (point) (point-max)))
1552 (when (search-forward "\n\n" nil t) 1562 (gnus-output-to-file filename)))))
1553 (narrow-to-region (point) (point-max)))
1554 (gnus-output-to-file filename))))
1555 ;; Remember the directory name to save articles.
1556 (setq gnus-newsgroup-last-file filename)))
1557 1563
1558 (defun gnus-summary-save-in-pipe (&optional command) 1564 (defun gnus-summary-save-in-pipe (&optional command)
1559 "Pipe this article to subprocess." 1565 "Pipe this article to subprocess."
1560 (interactive) 1566 (interactive)
1561 (gnus-set-global-variables) 1567 (gnus-set-global-variables)