(setq gnus-plugged plugged)
(gnus-run-hooks 'gnus-agent-unplugged-hook)
(setcar (cdr gnus-agent-mode-status) " Unplugged"))
- (set-buffer-modified-p t))
+ (force-mode-line-update))
(defun gnus-agent-close-connections ()
"Close all methods covered by the Gnus agent."
(day (- (gnus-time-to-day (current-time)) gnus-agent-expire-days))
gnus-command-method sym group articles
history overview file histories elem art nov-file low info
- unreads marked article)
+ unreads marked article orig lowest highest)
(save-excursion
(setq overview (gnus-get-buffer-create " *expire overview*"))
(while (setq gnus-command-method (pop methods))
- (let ((expiry-hashtb (gnus-make-hashtable 1023)))
- (gnus-agent-open-history)
- (set-buffer
- (setq gnus-agent-current-history
- (setq history (gnus-agent-history-buffer))))
- (goto-char (point-min))
- (when (> (buffer-size) 1)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^\t")
- (if (> (read (current-buffer)) day)
- ;; New article; we don't expire it.
- (forward-line 1)
- ;; Old article. Schedule it for possible nuking.
- (while (not (eolp))
- (setq sym (let ((obarray expiry-hashtb))
- (read (current-buffer))))
- (if (boundp sym)
- (set sym (cons (cons (read (current-buffer)) (point))
- (symbol-value sym)))
- (set sym (list (cons (read (current-buffer)) (point)))))
- (skip-chars-forward " "))
- (forward-line 1)))
- ;; We now have all articles that can possibly be expired.
- (mapatoms
- (lambda (sym)
- (setq group (symbol-name sym)
- articles (sort (symbol-value sym) 'car-less-than-car)
- low (car (gnus-active group))
- info (gnus-get-info group)
- unreads (ignore-errors (gnus-list-of-unread-articles group))
- marked (nconc (gnus-uncompress-range
- (cdr (assq 'tick (gnus-info-marks info))))
- (gnus-uncompress-range
- (cdr (assq 'dormant
- (gnus-info-marks info)))))
- nov-file (gnus-agent-article-name ".overview" group))
- (gnus-agent-load-alist group)
- (gnus-message 5 "Expiring articles in %s" group)
- (set-buffer overview)
- (erase-buffer)
- (when (file-exists-p nov-file)
- (nnheader-insert-file-contents nov-file))
- (goto-char (point-min))
- (setq article 0)
- (while (setq elem (pop articles))
- (setq article (car elem))
- (when (or (null low)
- (< article low)
- gnus-agent-expire-all
- (and (not (memq article unreads))
- (not (memq article marked))))
- ;; Find and nuke the NOV line.
- (while (and (not (eobp))
- (or (not (numberp
- (setq art (read (current-buffer)))))
- (< art article)))
- (if (file-exists-p
- (gnus-agent-article-name
- (number-to-string art) group))
- (forward-line 1)
- ;; Remove old NOV lines that have no articles.
- (gnus-delete-line)))
- (if (or (eobp)
- (/= art article))
- (beginning-of-line)
- (gnus-delete-line))
- ;; Nuke the article.
- (when (file-exists-p (setq file (gnus-agent-article-name
- (number-to-string article)
- group)))
- (delete-file file))
- ;; Schedule the history line for nuking.
- (push (cdr elem) histories)))
- (gnus-make-directory (file-name-directory nov-file))
- (write-region-as-coding-system
- gnus-agent-file-coding-system
- (point-min) (point-max) nov-file nil 'silent)
- ;; Delete the unwanted entries in the alist.
- (setq gnus-agent-article-alist
- (sort gnus-agent-article-alist 'car-less-than-car))
- (let* ((alist gnus-agent-article-alist)
- (prev (cons nil alist))
- (first prev)
- expired)
- (while (and alist
- (<= (caar alist) article))
- (if (or (not (cdar alist))
- (not (file-exists-p
- (gnus-agent-article-name
- (number-to-string
- (caar alist))
- group))))
- (progn
- (push (caar alist) expired)
- (setcdr prev (setq alist (cdr alist))))
- (setq prev alist
- alist (cdr alist))))
- (setq gnus-agent-article-alist (cdr first))
- ;;; Mark all articles up to the first article
- ;;; in `gnus-article-alist' as read.
- (when (and info (caar gnus-agent-article-alist))
- (setcar (nthcdr 2 info)
- (gnus-range-add
- (nth 2 info)
- (cons 1 (- (caar gnus-agent-article-alist) 1)))))
- ;; Maybe everything has been expired from `gnus-article-alist'
- ;; and so the above marking as read could not be conducted,
- ;; or there are expired article within the range of the alist.
- (when (and (car expired)
- (or (not (caar gnus-agent-article-alist))
- (> (car expired)
- (caar gnus-agent-article-alist))) )
- (setcar (nthcdr 2 info)
- (gnus-add-to-range
- (nth 2 info)
- (nreverse expired))))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string info)
- ")"))))
- expiry-hashtb)
- (set-buffer history)
- (setq histories (nreverse (sort histories '<)))
- (while histories
- (goto-char (pop histories))
- (gnus-delete-line))
- (gnus-agent-save-history)
- (gnus-agent-close-history))
- (gnus-message 4 "Expiry...done"))))))
+ (when (file-exists-p (gnus-agent-lib-file "active"))
+ (with-temp-buffer
+ (insert-file-contents (gnus-agent-lib-file "active"))
+ (gnus-active-to-gnus-format
+ gnus-command-method
+ (setq orig (gnus-make-hashtable
+ (count-lines (point-min) (point-max))))))
+ (let ((expiry-hashtb (gnus-make-hashtable 1023)))
+ (gnus-agent-open-history)
+ (set-buffer
+ (setq gnus-agent-current-history
+ (setq history (gnus-agent-history-buffer))))
+ (goto-char (point-min))
+ (when (> (buffer-size) 1)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward "^\t")
+ (if (> (read (current-buffer)) day)
+ ;; New article; we don't expire it.
+ (forward-line 1)
+ ;; Old article. Schedule it for possible nuking.
+ (while (not (eolp))
+ (setq sym (let ((obarray expiry-hashtb))
+ (read (current-buffer))))
+ (if (boundp sym)
+ (set sym (cons (cons (read (current-buffer)) (point))
+ (symbol-value sym)))
+ (set sym (list (cons (read (current-buffer)) (point)))))
+ (skip-chars-forward " "))
+ (forward-line 1)))
+ ;; We now have all articles that can possibly be expired.
+ (mapatoms
+ (lambda (sym)
+ (setq group (symbol-name sym)
+ articles (sort (symbol-value sym) 'car-less-than-car)
+ low (car (gnus-active group))
+ info (gnus-get-info group)
+ unreads (ignore-errors
+ (gnus-list-of-unread-articles group))
+ marked (nconc
+ (gnus-uncompress-range
+ (cdr (assq 'tick (gnus-info-marks info))))
+ (gnus-uncompress-range
+ (cdr (assq 'dormant
+ (gnus-info-marks info)))))
+ nov-file (gnus-agent-article-name ".overview" group)
+ lowest nil
+ highest nil)
+ (gnus-agent-load-alist group)
+ (gnus-message 5 "Expiring articles in %s" group)
+ (set-buffer overview)
+ (erase-buffer)
+ (when (file-exists-p nov-file)
+ (nnheader-insert-file-contents nov-file))
+ (goto-char (point-min))
+ (setq article 0)
+ (while (setq elem (pop articles))
+ (setq article (car elem))
+ (when (or (null low)
+ (< article low)
+ gnus-agent-expire-all
+ (and (not (memq article unreads))
+ (not (memq article marked))))
+ ;; Find and nuke the NOV line.
+ (while (and (not (eobp))
+ (or (not (numberp
+ (setq art (read (current-buffer)))))
+ (< art article)))
+ (if (file-exists-p
+ (gnus-agent-article-name
+ (number-to-string art) group))
+ (forward-line 1)
+ ;; Remove old NOV lines that have no articles.
+ (gnus-delete-line)))
+ (if (or (eobp)
+ (/= art article))
+ (beginning-of-line)
+ (gnus-delete-line))
+ ;; Nuke the article.
+ (when (file-exists-p (setq file (gnus-agent-article-name
+ (number-to-string
+ article)
+ group)))
+ (delete-file file))
+ ;; Schedule the history line for nuking.
+ (push (cdr elem) histories)))
+ (gnus-make-directory (file-name-directory nov-file))
+ (write-region-as-coding-system
+ gnus-agent-file-coding-system
+ (point-min) (point-max) nov-file nil 'silent)
+ ;; Delete the unwanted entries in the alist.
+ (setq gnus-agent-article-alist
+ (sort gnus-agent-article-alist 'car-less-than-car))
+ (let* ((alist gnus-agent-article-alist)
+ (prev (cons nil alist))
+ (first prev)
+ expired)
+ (while (and alist
+ (<= (caar alist) article))
+ (if (or (not (cdar alist))
+ (not (file-exists-p
+ (gnus-agent-article-name
+ (number-to-string
+ (caar alist))
+ group))))
+ (progn
+ (push (caar alist) expired)
+ (setcdr prev (setq alist (cdr alist))))
+ (setq prev alist
+ alist (cdr alist))))
+ (setq gnus-agent-article-alist (cdr first))
+ (gnus-agent-save-alist group)
+ ;; Mark all articles up to the first article
+ ;; in `gnus-article-alist' as read.
+ (when (and info (caar gnus-agent-article-alist))
+ (setcar (nthcdr 2 info)
+ (gnus-range-add
+ (nth 2 info)
+ (cons 1 (- (caar gnus-agent-article-alist) 1)))))
+ ;; Maybe everything has been expired from
+ ;;`gnus-article-alist' and so the above marking as read
+ ;;could not be conducted, or there are expired article
+ ;;within the range of the alist.
+ (when (and info
+ expired
+ (or (not (caar gnus-agent-article-alist))
+ (> (car expired)
+ (caar gnus-agent-article-alist))))
+ (setcar (nthcdr 2 info)
+ (gnus-add-to-range
+ (nth 2 info)
+ (nreverse expired))))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string info)
+ ")")))
+ (when lowest
+ (if (gnus-gethash group orig)
+ (setcar (gnus-gethash group orig) lowest)
+ (gnus-sethash group (cons lowest highest) orig))))
+ expiry-hashtb)
+ (set-buffer history)
+ (setq histories (nreverse (sort histories '<)))
+ (while histories
+ (goto-char (pop histories))
+ (gnus-delete-line))
+ (gnus-agent-save-history)
+ (gnus-agent-close-history)
+ (gnus-write-active-file
+ (gnus-agent-lib-file "active") orig))
+ (gnus-message 4 "Expiry...done")))))))
;;;###autoload
(defun gnus-agent-batch ()
;;; Code:
(require 'bbdb)
+(require 'bbdb-com)
(require 'gnus)
(require 'std11)
(eval-when-compile
record)))
;;;###autoload
-(defun gnus-bbdb/split-mail (header-filed bbdb-field &optional regexp group)
+(defun gnus-bbdb/split-mail (header-field bbdb-field
+ &optional regexp group)
"Mail split method for `nnmail-split-fancy'.
-HEADER-FILED is regexp of mail header field name for gathering mail
-addresses. BBDB-FIELD is field name of BBDB.
-Optional argument REGEXP is regexp of matching BBDB-FIELD value.
-If REGEXP is nil or not specified, then all BBDB-FIELD value is match.
-If GROUP is nil or not specified, then use BBDB-FIELD value as group
-name. Otherwise use GROUP."
- (or regexp (setq regexp ""))
- (let ((pat (concat "\\(" header-filed "\\)" ":[ \t]"))
- rest prop answer)
- (goto-char (point-min))
+HEADER-FIELED is a regexp or list of regexps as mail header field name
+for gathering mail addresses. If HEADER-FIELED is a string, then it's
+used for just matching pattern. If HEADER-FIELED is a list of strings,
+then these strings have priorities in the order.
+
+BBDB-FIELD is field name of BBDB.
+Optional argument REGEXP is regexp string for matching BBDB-FIELD value.
+If REGEXP is nil or not specified, then all BBDB-FIELD value is matched.
+
+If GROUP is nil or not specified, then BBDB-FIELD value is returned as
+group name. If GROUP is a symbol `&', then list of all matcing group's
+BBDB-FEILD values is returned. Otherwise, GROUP is returned."
+ (if (listp header-field)
+ (if (eq group '&)
+ (gnus-bbdb/split-mail (mapconcat 'identity header-field "\\|")
+ bbdb-field regexp group)
+ (let (rest)
+ (while (and header-field
+ (null (setq rest (gnus-bbdb/split-mail
+ (car header-field) bbdb-field
+ regexp group))))
+ (setq header-field (cdr header-field)))
+ rest))
+ (let ((pat (concat "^\\(" header-field "\\):[ \t]"))
+ header-values)
+ (goto-char (point-min))
+ (while (re-search-forward pat nil t)
+ (setq header-values (cons (buffer-substring (point)
+ (std11-field-end))
+ header-values)))
+ (let ((address-regexp
+ (mapconcat
+ (lambda (lal)
+ (regexp-quote (std11-address-string lal)))
+ (apply 'nconc
+ (mapcar #'std11-parse-addresses-string
+ header-values))
+ "\\|")))
+ (unless (zerop (length address-regexp))
+ (gnus-bbdb/split-mail-1 address-regexp bbdb-field regexp group))))))
+
+(defun gnus-bbdb/split-mail-1 (address-regexp bbdb-field regexp group)
+ (let ((records (bbdb-search (bbdb-records) nil nil address-regexp))
+ prop rest)
+ (or regexp (setq regexp ""))
(catch 'done
- (while (< (point) (point-max))
- (when (looking-at pat)
- (mapcar
- (lambda (lal)
- (condition-case nil
- (let ((prop (bbdb-record-getprop
- (bbdb-search-simple nil
- (std11-address-string lal))
- bbdb-field)))
- (and (string-match regexp prop)
- (throw 'done (or group prop))))
- (error nil)
- ))
- (std11-parse-addresses-string (buffer-substring (match-end 0)
- (std11-field-end)))
- ))
- (forward-line)
- ))))
+ (cond
+ ((eq group '&)
+ (while records
+ (when (and (setq prop (bbdb-record-getprop (car records) bbdb-field))
+ (string-match regexp prop)
+ (not (member prop rest)))
+ (setq rest (cons prop rest)))
+ (setq records (cdr records)))
+ (throw 'done (when rest (cons '& rest))))
+ (t
+ (while records
+ (when (or (null bbdb-field)
+ (and (setq prop (bbdb-record-getprop (car records)
+ bbdb-field))
+ (string-match regexp prop)))
+ (throw 'done (or group prop)))
+ (setq records (cdr records))))))))
;;
;; Announcing BBDB entries in the summary buffer
;; Weed out all mail methods.
(while methods
(setq method (gnus-server-get-method "" (pop methods)))
- (when (or (gnus-method-option-p method 'post)
- (gnus-method-option-p method 'post-mail))
+ (when (and (or (gnus-method-option-p method 'post)
+ (gnus-method-option-p method 'post-mail))
+ (not (member method post-methods)))
(push method post-methods)))
;; Create a name-method alist.
(setq method-alist
;; Override normal method.
((and (eq gnus-post-method 'current)
(not (eq (car group-method) 'nndraft))
+ (gnus-get-function group-method 'request-post t)
(not arg))
- group-method)
+ group-method)
((and gnus-post-method
(not (eq gnus-post-method 'current)))
gnus-post-method)
(gnus-summary-select-article)
(let ((charset default-mime-charset))
(set-buffer gnus-original-article-buffer)
- (make-local-variable 'default-mime-charset)
- (setq default-mime-charset charset)
- )
+ (set (make-local-variable 'default-mime-charset) charset))
(let ((message-included-forward-headers
(if full-headers "" message-included-forward-headers)))
(message-forward post))))
(goto-char (point-min)))
(message-pop-to-buffer "*Gnus Bug*")
(message-setup
- `((To . ,gnus-maintainer) (Cc . ,semi-gnus-developers) (Subject . "")))
+ `((To . ,semi-gnus-developers) (Subject . "")))
(when gnus-bug-create-help-buffer
(push `(gnus-bug-kill-buffer) message-send-actions))
(goto-char (point-min))
;;; gnus-offline.el --- To process mail & news at offline environment.
-;;; $Id: gnus-offline.el,v 1.1.6.4 1999-04-28 05:07:54 keiichi Exp $
+;;; $Id: gnus-offline.el,v 1.1.6.4.2.1 2000-02-10 01:12:37 keiichi Exp $
;;; Copyright (C) 1998 Tatsuya Ichikawa
;;; Yukihiro Ito
;;; In Gnus group buffer , type g to get all news and mail.
;;; Then send mail and news in spool directory.
;;;
-;;; Security Notice. (This is available before version 2.02)
-;;;
-;;; You can set the variable gnus-offline-pop-password-file to save your POP
-;;; passwords. But TAKE CARE. Use it at your own risk.
-;;; If you decide to use it, then write in .emacs or .gnus-offline.el
-;;; something like:
-;;;
-;;; (setq gnus-offline-pop-password-file "~/.pop.passwd")
-;;;
-;;; and write in this file something like:
-;;;
-;;; (setq pop3-fma-password
-;;; '(("SERVER1" "ACCOUNT1" "PASSWORD1")
-;;; ("SERVER2" "ACCOUNT2" "PASSWORD2")
-;;; ............................
-;;; ))
-;;;
-;;; If you want to encode the file with base64, try:
-;;;
-;;; M-: (base64-encode-region (point-min) (point-max))
-;;;
;;; Variables.
;;; gnus-offline-dialup-program-arguments
;;; ... List of dialup program arguments.
;;; (minutes)
;;; gnus-offline-dialup-function ... Function to diualup.
;;; gnus-offline-hangup-function ... Function to hangup.
-;;; gnus-offline-pop-password-file ... File to keep the POP password info.
-;;; gnus-offline-pop-password-decoding-function
-;;; ... Function to decode the password info.
;;; Code:
(if (functionp gnus-offline-dialup-function)
(funcall gnus-offline-dialup-function))
(gnus-offline-get-new-news-function)
- (if (null gnus-offline-pop-password-file)
- (gnus-group-get-new-news arg)
- (let ((buffer (get-buffer-create "*offline-temp*")))
- (unwind-protect
- (progn
- (if (boundp 'pop3-fma-password)
- (setq pop3-fma-save-password-information t))
- (save-excursion
- (set-buffer buffer)
- (erase-buffer)
- (insert-file-contents-as-binary gnus-offline-pop-password-file)
- (and gnus-offline-pop-password-decoding-function
- (funcall gnus-offline-pop-password-decoding-function))
- (eval-buffer))
- (gnus-group-get-new-news arg))
- (if (boundp 'pop3-fma-password)
- (setq pop3-fma-password nil
- pop3-fma-save-password-information nil)
- (setq mail-source-password-cache nil))
- (kill-buffer buffer)))))
+ (gnus-group-get-new-news arg))
;;
;; dialup...
(defun gnus-offline-enable-fetch-mail ()
"*Set to fetch mail."
(setq gnus-offline-mail-fetch-method 'nnmail)
- (if (not (featurep 'running-pterodactyl-gnus-0_73-or-later))
- (progn
- (setq nnmail-movemail-program 'pop3-fma-movemail)
- (setq nnmail-spool-file (append
- pop3-fma-local-spool-file-alist
- (mapcar
- (lambda (spool)
- (car spool))
- pop3-fma-spool-file-alist))))
- (setq nnmail-spool-file gnus-offline-mail-source)))
+ (setq nnmail-spool-file gnus-offline-mail-source))
;;
;; Enable fetch news
;;
"*Toggle movemail program movemail -> pop3.el -> movemail ->..."
(interactive)
(setq string "Set nnmail-movemail-program")
- (cond ((eq pop3-fma-movemail-type 'lisp)
- (setq pop3-fma-movemail-type 'exe
+ (cond ((eq nnmail-movemail-program 'nnmail-pop3-movemail)
+ (setq nnmail-movemail-program "movemail"
str "to movemail"))
(t
- (setq pop3-fma-movemail-type 'lisp
+ (setq nnmail-movemail-program 'nnmail-pop3-movemail
str "to pop3.el")))
(message (format "%s %s" string str)))
;;
;;;
;;; Copyright (C) 1998 Tatsuya Ichikawa
;;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;;; Author: Keiichi Suzuki <keiichi@nanap.org>
;;;
-;;; This file is part of Semi-gnus.
+;;; This file is part of Nana-gnus.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;;; Commentary:
;;; How to use.
;;;
-;;; M-x load[RET]gnus-ofsetup
-;;; M-x gnus-setup-for-offline
+;;; M-x load-library[RET]gnus-ofsetup[RET]
+;;; M-x gnus-setup-for-offline[RET]
;;;
;;; Code:
-(defvar gnus-offline-setting-file "~/.gnus-offline.el")
-(defvar gnus-offline-use-miee nil)
-(defvar gnus-offline-news-fetch-method nil)
-(defvar gnus-offline-mail-fetch-method nil)
-(defvar gnus-offline-hangup-program nil)
-(defvar gnus-offline-dialup-program nil)
-(defvar pop3-fma-spool-file-alist nil)
-(defvar pop3-fma-movemail-type nil)
-(defvar pop3-fma-movemail-arguments nil)
-(defvar use-miee nil)
-(defvar address nil)
-(defvar mail-source nil)
-(defvar options nil)
+(eval-when-compile
+ (require 'poe))
-;;; To silence byte compiler
-(and
- (fboundp 'eval-when-compile)
- (eval-when-compile
- (save-excursion
- (beginning-of-defun)
- (eval-region (point-min) (point)))
- (let (case-fold-search)
- (mapcar
- (function
- (lambda (symbol)
- (unless (boundp symbol)
- (make-local-variable symbol)
- (eval (list 'setq symbol nil)))))
- '(:group
- :prefix :type
- sendmail-to-spool-directory
- news-spool-request-post-directory
- nnspool-version
- nnagent-version
- msspool-news-server
- msspool-news-service
- gnspool-get-news
- mail-spool-send
- news-spool-post
- gnus-agent-handle-level
- ))
- (make-local-variable 'byte-compile-warnings)
- (setq byte-compile-warnings nil))))
+(defvar gnus-offline-setting-file "~/.nana-gnus-offline.el")
+
+(defun gnus-ofsetup-read-from-minibuffer (format &rest args)
+ (let ((server
+ (read-from-minibuffer
+ (apply 'format
+ (concat format
+ " (if you are finished, input null string.) : ")
+ args))))
+ (unless (string-match "^[ \t]*$" server)
+ server)))
+
+(defun gnus-ofsetup-completing-read-symbol (msg &rest syms)
+ (intern
+ (completing-read (concat msg " (TAB to completion): ")
+ (mapcar
+ (lambda (sym)
+ (list (symbol-name sym)))
+ syms)
+ nil t nil)))
+
+(defun gnus-ofsetup-read-pop-account (server)
+ (let ((account (gnus-ofsetup-read-from-minibuffer
+ "Mail account at \"%s\"" server)))
+ (when account
+ (let ((auth (gnus-ofsetup-completing-read-symbol
+ "Authentification Method"
+ 'pass 'apop)))
+ (list (concat "po:" account "@" server) :auth-scheme auth)))))
(defun gnus-setup-for-offline ()
"*Set up Gnus for offline environment."
(interactive)
-
- (if (not (file-exists-p gnus-offline-setting-file))
- (progn
- (let ((news-method
- (completing-read
- "Method for offline News reading (TAB to completion): "
- '(("gnus-agent" 1) ("nnspool" 2))
- nil t nil))
- (mail-method 'nnmail)
- (program
- (read-file-name "Dialup/Hangup program(type nil or null string you do not use): "))
- (mta-type
- (completing-read
- "Select MTA type for sending mail (TAB to completion): "
- '(("smtp" 1) ("sendmail" 2))
- nil t nil))
- (num-of-address
- (read-from-minibuffer "How many e-mail address do you have: "))
- )
- (if (string-equal news-method "nnspool")
- (setq use-miee t)
- (setq use-miee (y-or-n-p "Use MIEE post/send message ")))
- ;;
- ;; Set variables.
- (if (string-equal news-method "gnus-agent")
- (setq gnus-offline-news-fetch-method 'nnagent)
- (setq gnus-offline-news-fetch-method 'nnspool))
- ;;
- (setq gnus-offline-mail-fetch-method mail-method)
- (setq gnus-offline-use-miee use-miee)
-
- ;; Set programs.
- (if (or (string-equal program "nil")
- (string-equal program ""))
- (progn
- (setq gnus-offline-hangup-program nil)
- (setq gnus-offline-dialup-program nil))
- (let ((options
- (read-from-minibuffer "Dialup program options: ")))
- (setq gnus-offline-dialup-program-arguments
- (split-string options "[\t ]+")))
- (let ((options
- (read-from-minibuffer "Hangup program options: ")))
- (setq gnus-offline-hangup-program-arguments
- (split-string options "[\t ]+")))
- (setq gnus-offline-hangup-program program)
- (setq gnus-offline-dialup-program program))
-
- ;; Set spool directory for outgoing messages.
- (if use-miee
- (progn
- ;; Setting for MIEE with nnspool.
- (let ((news-spool
- (read-from-minibuffer
- "News spool directory for sending: "
- "/usr/spool/news.out"))
- (mail-spool
- (read-from-minibuffer
- "Mail spool directory for sending: "
- "/usr/spool/mail.out")))
- (setq gnus-offline-mail-spool-directory mail-spool)
- (setq gnus-offline-news-spool-directory news-spool)
- (setq gnus-offline-drafts-queue-type 'miee)
-
- ;; Load MIEE.
- (load "miee")
- ;; Set news post function for MIEE.
- (setq message-send-news-function 'gnspool-request-post)
- ;; Spool directory setting - MIEE.
- (if (not (file-exists-p gnus-offline-mail-spool-directory))
- (make-directory gnus-offline-mail-spool-directory t))
- (setq sendmail-to-spool-directory
- gnus-offline-mail-spool-directory)
- (if (not (file-exists-p gnus-offline-news-spool-directory))
- (make-directory gnus-offline-news-spool-directory t))
- (setq news-spool-request-post-directory
- gnus-offline-news-spool-directory)))
-
- ;; Set drafts type gnus-agent.
- (setq gnus-offline-drafts-queue-type 'agent))
-
- ;; Setting for gnus-agent.
- (if (eq gnus-offline-news-fetch-method 'nnagent)
- (let ((agent-directory
- (read-from-minibuffer "Agent directory: " "~/News/agent")))
- (setq gnus-agent-directory agent-directory)))
-
- ;; Determin MTA type.
- (if (string-equal mta-type "smtp")
- (setq gnus-offline-MTA-type 'smtp)
- (setq gnus-offline-MTA-type 'sendmail)
- )
- ;;
- ;; Set E-Mail Address and pop3 movemail type.
- (setq i (string-to-int num-of-address))
- (setq address nil)
- (if (not (locate-library "mail-source"))
- (progn
- (while (> i 0)
- (setq address
- (append address
- (list
- (list
- (concat "po:"
- (read-from-minibuffer
- "Email address (user@mailhost): "))
- (completing-read
- "Authentification Method (TAB to completion): "
- '(("pass" 1) ("apop" 2)) nil t nil)))))
- (setq i (- i 1)))
- ;; Replace "hoge" -> 'hoge
- (mapcar
- (lambda (x)
- (if (string-equal (nth 1 x) "pass")
- (setcar (cdr x) 'pass)
- (setcar (cdr x) 'apop)))
- address)
- (setq pop3-fma-spool-file-alist address)
- ;; Set movemail type.
- (let ((movemail-type
- (completing-read
- "Select movemail type for retreave mail (TAB to completion): "
- '(("exe" 1) ("lisp" 2))
- nil t nil))
- )
- (if (string-equal movemail-type "exe")
- (let ((options
- (read-from-minibuffer "movemail options: ")))
- (setq pop3-fma-movemail-arguments (split-string options "[\t ]+"))))
- (if (string-equal movemail-type "exe")
- (setq pop3-fma-movemail-type 'exe)
- (setq pop3-fma-movemail-type 'lisp))))
- ;;
- ;; Use mail-source.el
- (setq mail-source nil)
- (while (> i 0)
- (let ((user (read-from-minibuffer "Mail Account name : "))
- (server (read-from-minibuffer "Mail server : "))
- (auth (completing-read
- "Authentification Method (TAB to completion): "
- '(("pop" 1) ("apop" 2)) nil t nil))
- (islisp (y-or-n-p "Do you use pop3.el to fetch mail? ")))
- (if (not islisp)
- (let ((prog (read-file-name "movemail program name: "
- exec-directory "movemail"))
- (args (read-from-minibuffer "movemail options: " "-pf")))
- (setq mail-source
- (append mail-source
- (list
- (list
- 'pop
- :user user
- :server server
- :program
- (format "%s %s %s %s %s"
- prog
- args
- "po:%u"
- "%t"
- "%p")
- :authentication auth)))))
- (setq mail-source
- (append mail-source
- (list
- (list
- 'pop
- :user user
- :server server
- :authentication auth))))))
- (setq i (- i 1)))
- ;; Replace "hoge" -> 'hoge
- (mapcar
- (lambda (x)
- (if (string-equal (car (last x)) "pop")
- (setcar (last x) (quote 'pop))
- (setcar (last x) (quote 'apop))))
- mail-source)
- (setq gnus-offline-mail-source mail-source)))
+ (unless (file-exists-p gnus-offline-setting-file)
+ (let (movemail-option
+ news-fetch-method mail-fetch-method agent-directory drafts-queue-type
+ news-spool-directory mail-spool-directory send-news-function
+ sendmail-to-spool-directory news-spool-request-post-directory
+ MTA-type dialup-program dialup-program-arguments hangup-program
+ hangup-program-arguments movemail-program
+ movemail-program-apop-option spool-file save-passwd)
+ (setq news-fetch-method
+ (gnus-ofsetup-completing-read-symbol
+ "Method for offline News reading"
+ 'nnagent 'nnspool))
+ (when (eq news-fetch-method 'nnagent)
+ (setq agent-directory
+ (read-from-minibuffer "Agent directory: " "~/News/agent")))
+ (setq drafts-queue-type
+ (cond
+ ((or (eq news-fetch-method 'nnspool)
+ (y-or-n-p "Use MIEE post/send message "))
+ ;; Setting for MIEE with nnspool.
+ (setq news-spool-directory
+ (read-from-minibuffer
+ "News spool directory for sending: "
+ "/usr/spool/news.out"))
+ (setq mail-spool-directory
+ (read-from-minibuffer
+ "Mail spool directory for sending: "
+ "/usr/spool/mail.out"))
+ ;; Set news post function for MIEE.
+ (setq send-news-function 'gnspool-request-post)
+ ;; Spool directory setting - MIEE.
+ (unless (file-exists-p mail-spool-directory)
+ (make-directory mail-spool-directory t))
+ (setq sendmail-to-spool-directory mail-spool-directory)
+ (unless (file-exists-p news-spool-directory)
+ (make-directory news-spool-directory t))
+ (setq news-spool-request-post-directory news-spool-directory)
+ 'miee)
+ (t
+ 'agent)))
+ (setq mail-fetch-method 'nnmail)
+ (setq MTA-type (gnus-ofsetup-completing-read-symbol
+ "Select MTA type for sending mail"
+ 'smtp 'sendmail))
+ (setq dialup-program
+ (read-file-name
+ "Dialup program (if you do not use it, input null string): "
+ nil nil t))
+ (if (string-match "^[ \t]*$" dialup-program)
+ (setq dialup-program nil)
+ (setq dialup-program-arguments
+ (split-string
+ (read-from-minibuffer "Dialup program options: ")
+ "[\t ]+")))
+ (setq hangup-program
+ (read-file-name
+ "Hangup program (if you do not use it, input null string): "
+ (and dialup-program
+ (file-name-directory dialup-program))
+ dialup-program
+ t))
+ (if (string-match "^[ \t]*$" hangup-program)
+ (setq hangup-program nil)
+ (setq hangup-program-arguments
+ (split-string
+ (read-from-minibuffer "Hangup program options: ")
+ "[\t ]+")))
+ ;; Set `movemail' type.
+ (setq movemail-program
+ (if (y-or-n-p "Do you use pop3.el to fetch mail? ")
+ 'nnmail-pop3-movemail
+ (read-file-name "movemail program name: "
+ exec-directory "movemail")))
+ (when (stringp movemail-program)
+ (setq movemail-option (read-from-minibuffer "movemail options: " "-f"))
+ (setq movemail-program-apop-option
+ (read-from-minibuffer "movemail options for APOP: ")))
+
+ ;; Set E-Mail Addresses.
+ (setq spool-file nil)
+ (let (server spool)
+ (while (setq server (gnus-ofsetup-read-from-minibuffer "POP server"))
+ (while (setq spool (gnus-ofsetup-read-pop-account server))
+ (setq spool-file (cons spool spool-file)))))
+
+ (while (not save-passwd)
(setq save-passwd
- (y-or-n-p "Do you save password information to newsrc file? "))
+ (gnus-ofsetup-completing-read-symbol
+ "How long do you save password"
+ 'never 'exit-emacs 'permanence))
+ (if (and (eq save-passwd 'permanence)
+ (not (y-or-n-p
+ "Your password will be saved to newsrc file. OK? ")))
+ (setq save-passwd nil)))
- ;; Write to setting file.
- (setq tmp-buffer (get-buffer-create "* Setting"))
- (set-buffer "* Setting")
+ ;; Write to setting file.
+ (save-excursion
+ (set-buffer (get-buffer-create "* Setting"))
(erase-buffer)
(insert ";;\n");
(insert ";; This file is created by gnus-ofsetup.el\n")
- (insert ";; Creation date : ")
- (insert (current-time-string))
- (insert "\n")
+ (insert ";; Creation date : " (current-time-string) "\n")
(insert ";;\n")
;; write Basic setting
- (insert "(setq gnus-offline-news-fetch-method '")
- (insert (prin1-to-string gnus-offline-news-fetch-method))
- (insert ")\n")
- (insert "(setq gnus-offline-mail-fetch-method '")
- (insert (prin1-to-string gnus-offline-mail-fetch-method))
- (insert ")\n")
- (insert "(setq gnus-offline-use-miee ")
- (insert (prin1-to-string gnus-offline-use-miee))
- (insert ")\n")
- (insert "(setq gnus-offline-dialup-program ")
- (insert (prin1-to-string gnus-offline-dialup-program))
- (insert ")\n")
+ (insert "(setq gnus-offline-news-fetch-method '"
+ (prin1-to-string news-fetch-method) ")\n")
+ (insert "(setq gnus-offline-mail-fetch-method '"
+ (prin1-to-string mail-fetch-method) ")\n")
;; write dialup/hangup program and options.
- (if (stringp gnus-offline-dialup-program)
- (progn
- (insert "(setq gnus-offline-dialup-program-arguments '")
- (insert (prin1-to-string gnus-offline-dialup-program-arguments))
- (insert ")\n")))
- (insert "(setq gnus-offline-hangup-program ")
- (insert (prin1-to-string gnus-offline-hangup-program))
- (insert ")\n")
- (if (stringp gnus-offline-hangup-program)
- (progn
- (insert "(setq gnus-offline-hangup-program-arguments '")
- (insert (prin1-to-string gnus-offline-hangup-program-arguments))
- (insert ")\n")))
+ (insert "(setq gnus-offline-dialup-program "
+ (prin1-to-string dialup-program) ")\n")
+ (when (stringp dialup-program)
+ (insert "(setq gnus-offline-dialup-program-arguments '"
+ (prin1-to-string dialup-program-arguments) ")\n"))
+ (insert "(setq gnus-offline-hangup-program "
+ (prin1-to-string hangup-program) ")\n")
+ (when (stringp hangup-program)
+ (insert "(setq gnus-offline-hangup-program-arguments '"
+ (prin1-to-string hangup-program-arguments)
+ ")\n"))
;; write setting about MIEE.
- (if gnus-offline-use-miee
- (progn
- (insert "(setq gnus-offline-mail-spool-directory ")
- (insert (prin1-to-string gnus-offline-mail-spool-directory))
- (insert ")\n")
- (insert "(setq gnus-offline-news-spool-directory ")
- (insert (prin1-to-string gnus-offline-news-spool-directory))
- (insert ")\n")
- (insert "(setq sendmail-to-spool-directory gnus-offline-mail-spool-directory)\n")
- (insert "(setq news-spool-request-post-directory gnus-offline-news-spool-directory)\n")
- (insert "(load \"miee\")\n")
- (insert "(setq message-send-news-function '")
- (insert (prin1-to-string message-send-news-function))
- (insert ")\n")))
+ (when (eq drafts-queue-type 'miee)
+ (insert "(setq gnus-offline-mail-spool-directory "
+ (prin1-to-string mail-spool-directory) ")\n")
+ (insert "(setq gnus-offline-news-spool-directory "
+ (prin1-to-string news-spool-directory) ")\n")
+ (insert "(setq sendmail-to-spool-directory\n"
+ "gnus-offline-mail-spool-directory)\n")
+ (insert "(setq news-spool-request-post-directory\n"
+ "gnus-offline-news-spool-directory)\n")
+ (insert "(load \"miee\")\n")
+ (insert "(setq message-send-news-function '"
+ (prin1-to-string send-news-function) ")\n"))
;; write setting about nnspool and gnus-agent.
- (if (equal gnus-offline-news-fetch-method 'nnspool)
+ (if (equal news-fetch-method 'nnspool)
(insert "(message-offline-state)\n")
- (insert "(setq gnus-agent-directory ")
- (insert (prin1-to-string gnus-agent-directory))
- (insert ")\n"))
+ (insert "(setq gnus-agent-directory "
+ (prin1-to-string agent-directory) ")\n"))
;; write setting about queue type -- MIEE or nnagent.
- (insert "(setq gnus-offline-drafts-queue-type '")
- (insert (prin1-to-string gnus-offline-drafts-queue-type))
- (insert ")\n")
- (insert "(setq gnus-offline-MTA-type '")
- (insert (prin1-to-string gnus-offline-MTA-type))
- (insert ")\n")
+ (insert "(setq gnus-offline-drafts-queue-type '"
+ (prin1-to-string drafts-queue-type) ")\n")
+ (insert "(setq gnus-offline-MTA-type '"
+ (prin1-to-string MTA-type) ")\n")
;; Offline setting for gnus-nntp-*
(insert "(setq gnus-nntp-service nil)\n")
(insert "(add-hook 'gnus-group-mode-hook 'gnus-offline-error-check t)\n")
(insert "(add-hook 'gnus-after-getting-new-news-hook 'gnus-offline-after-get-new-news)\n")
(insert "(add-hook 'gnus-after-getting-news-hook 'gnus-offline-after-get-new-news)\n")
- (if (eq gnus-offline-news-fetch-method 'nnspool)
- (progn
- (insert "(add-hook 'after-getting-news-hook 'gnus-offline-nnspool-hangup-line)\n")
- (insert "(add-hook 'gnus-before-startup-hook (lambda () (setq nnmail-spool-file nil)))\n")))
+ (when (eq news-fetch-method 'nnspool)
+ (insert "(add-hook 'gnus-after-getting-news-hook 'gnus-offline-nnspool-hangup-line)\n")
+ (insert "(add-hook 'gnus-before-startup-hook (lambda () (setq nnmail-spool-file nil)))\n"))
(insert "(add-hook 'message-send-hook 'gnus-offline-message-add-header)\n")
(insert "(autoload 'gnus-offline-setup \"gnus-offline\")\n")
(insert "(add-hook 'gnus-load-hook 'gnus-offline-setup)\n")
- (if (not (locate-library "mail-source"))
- (progn
- ;; Write setting about pop3-fma.
- (insert "(require 'pop3-fma)\n")
- (insert "(add-hook 'message-send-hook 'pop3-fma-message-add-header)\n")
- (insert "(setq pop3-fma-spool-file-alist '")
- (insert (prin1-to-string pop3-fma-spool-file-alist))
- (insert ")\n")
- (insert "(setq pop3-fma-movemail-type '")
- (insert (prin1-to-string pop3-fma-movemail-type))
- (insert ")\n")
- (if save-passwd
- (insert "(add-hook 'gnus-setup-news-hook \n (lambda ()\n (setq pop3-fma-save-password-information t)\n (add-to-list 'gnus-variable-list 'pop3-fma-password)))\n"))
- (if (eq pop3-fma-movemail-type 'exe)
- (progn
- (insert "(setq pop3-fma-movemail-arguments '")
- (insert (prin1-to-string pop3-fma-movemail-arguments))
- (insert ")\n"))))
- ;; Write stting about mail-source.el
- (insert "(setq gnus-offline-mail-source '")
- (insert (prin1-to-string gnus-offline-mail-source))
- (insert ")\n")
- (insert "(setq nnmail-spool-file gnus-offline-mail-source)\n")
- (insert "(require 'read-passwd)\n")
- (insert "(setq mail-source-read-passwd 'read-pw-read-passwd)\n")
- (insert "(add-hook 'gnus-setup-news-hook 'read-pw-set-mail-source-passwd-cache)\n")
- (if save-passwd
- (insert "(add-hook 'gnus-setup-news-hook \n (lambda ()\n (add-to-list 'gnus-variable-list 'mail-source-password-cache)))\n"))
- )
- (write-region (point-min) (point-max) gnus-offline-setting-file)
- (kill-buffer "* Setting"))
- )
+ ;; Write stting about nnmail.el
+ (insert "(setq nnmail-movemail-program '"
+ (prin1-to-string movemail-program) ")\n")
+ (when (stringp movemail-program)
+ (insert "(setenv \"MOVEMAIL\""
+ (prin1-to-string movemail-option) ")\n")
+ (insert "(setq nnmail-movemail-program-apop-option '"
+ (prin1-to-string movemail-program-apop-option) ")\n"))
+ (insert "(setq gnus-offline-mail-source '"
+ (prin1-to-string spool-file) ")\n")
+ (insert
+ (cond
+ ((eq save-passwd 'never)
+ "(setq nnmail-pop-password-required nil)\n")
+ ((eq save-passwd 'exit-emacs)
+ "(setq nnmail-pop-password-required t)\n")
+ ((eq save-passwd 'permanence)
+ "(setq nnmail-pop-password-required t)
+(add-hook 'gnus-setup-news-hook
+ (lambda ()
+ (add-to-list 'gnus-variable-list 'nnmail-internal-password-cache)))\n")))
+ (write-region (point-min) (point-max) gnus-offline-setting-file))
+ (kill-buffer "* Setting")))
(load gnus-offline-setting-file))
+
;; gnus-ofsetup.el Ends here.
(progn
(set-syntax-table gnus-adaptive-word-syntax-table)
(while (re-search-forward "\\b\\w+\\b" nil t)
- (setq val
- (gnus-gethash
- (setq word (downcase (buffer-substring
- (match-beginning 0) (match-end 0))))
+ (condition-case err
+ (progn
+ (setq val
+ (gnus-gethash
+ (setq word (downcase
+ (buffer-substring
+ (match-beginning 0) (match-end 0))))
+ hashtb))
+ (gnus-sethash
+ word
+ (append (get-text-property (gnus-point-at-eol) 'articles)
+ val)
hashtb))
- (gnus-sethash
- word
- (append (get-text-property (gnus-point-at-eol) 'articles) val)
- hashtb)))
+ (error (gnus-error 1.1 "%s" err)))))
(set-syntax-table syntab))
;; Make all the ignorable words ignored.
(let ((ignored (append gnus-ignored-adaptive-words
(require 'nnheader)
(require 'timezone)
(require 'message)
-(eval-when-compile
- (when (locate-library "rmail")
- (require 'rmail)))
(eval-and-compile
(autoload 'nnmail-date-to-time "nnmail")
re
(unless (string-match "\\$$" re) ".*$")))
+(defun gnus-write-active-file (file hashtb &optional full-names)
+ (with-temp-file file
+ (mapatoms
+ (lambda (sym)
+ (when (and sym
+ (boundp sym)
+ (symbol-value sym))
+ (insert (format "%S %d %d y\n"
+ (if full-names
+ sym
+ (intern (gnus-group-real-name (symbol-name sym))))
+ (or (cdr (symbol-value sym))
+ (car (symbol-value sym)))
+ (car (symbol-value sym))))))
+ hashtb)
+ (goto-char (point-max))
+ (while (search-backward "\\." nil t)
+ (delete-char 1))))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
(defconst gnus-product-name "Nana-gnus"
"Product name of this version of gnus.")
-(defconst gnus-version-number "6.12.19"
+(defconst gnus-version-number "6.12.20"
"Version number for this version of gnus.")
(defconst gnus-version
(defcustom message-yank-add-new-references t
"*Non-nil means new IDs will be added to \"References\" field when an
article is yanked by the command `message-yank-original' interactively."
- :type 'boolean
+ :type '(radio (const :tag "Do not add anything" nil)
+ (const :tag "From Message-Id, References and In-Reply-To fields" t)
+ (const :tag "From only Message-Id field." message-id-only))
+ :group 'message-insertion)
+
+(defcustom message-list-references-add-position nil
+ "*Integer value means position for adding to \"References\" field when
+an article is yanked by the command `message-yank-original' interactively."
+ :type '(radio (const :tag "Add to last" nil)
+ (integer :tag "Position from last ID"))
:group 'message-insertion)
(defcustom message-indentation-spaces 3
(defun message-list-references (refs-list &rest refs-strs)
"Add `Message-ID's which appear in REFS-STRS but not in REFS-LIST,
to REFS-LIST."
- (let (refs ref id)
+ (let (refs ref id saved-id)
+ (when (and refs-list
+ (integerp message-list-references-add-position))
+ (let ((pos message-list-references-add-position))
+ (while (and refs-list
+ (> pos 0))
+ (setq saved-id (cons (car refs-list) saved-id)
+ refs-list (cdr refs-list)
+ pos (1- pos)))))
(while refs-strs
(setq refs (car refs-strs)
refs-strs (cdr refs-strs))
">"))
(or (member id refs-list)
(push id refs-list))))))
+ (while saved-id
+ (setq refs-list (cons (car saved-id) refs-list)
+ saved-id (cdr saved-id)))
refs-list))
(defvar gnus-article-copy)
In addition, if `message-yank-add-new-references' is non-nil and this
command is called interactively, new IDs from the yanked article will
-be added to \"References\" field."
+be added to \"References\" field.
+\(See also `message-yank-add-new-references'.)"
(interactive "P")
(let ((modified (buffer-modified-p))
(buffer (message-eval-parameter message-reply-buffer))
(std11-narrow-to-header)
(when (setq refs (message-list-references
refs
- (or (message-fetch-field "References")
- (message-fetch-field "In-Reply-To"))
+ (unless (eq message-yank-add-new-references
+ 'message-id-only)
+ (or (message-fetch-field "References")
+ (message-fetch-field "In-Reply-To")))
(message-fetch-field "Message-ID")))
(widen)
(message-narrow-to-headers)
(require 'mail-utils)
(require 'mime)
+(require 'poem) ; For using coding system
+ ; `raw-text-dos' on XEmacs.
(defvar nnheader-max-head-length 4096
"*Max length of the head of articles.")
:group 'nnmail-retrieve
:type 'string)
+(defcustom nnmail-movemail-program-apop-option "-A"
+ "*APOP option parameter for a command to be executed to move mail
+ from the inbox.
+The default is \"-A\"."
+ :group 'nnmail-files
+ :group 'nnmail-retrieve
+ :type 'string)
+
+(defcustom nnmail-movemail-program-pop-password-required t
+ "*Non-nil if a password is required when reading mail using POP
+with `movemail' external program."
+ :group 'nnmail-retrieve
+ :type 'boolean)
+
(defcustom nnmail-pop-password-required nil
"*Non-nil if a password is required when reading mail using POP."
:group 'nnmail-retrieve
(list (cons inbox password)))))
;; Function rewritten from rmail.el.
-(defun nnmail-move-inbox (inbox)
+(defun nnmail-move-inbox (inbox &optional inbox-options)
"Move INBOX to `nnmail-crash-box'."
(if (not (file-writable-p nnmail-crash-box))
(gnus-error 1 "Can't write to crash box %s. Not moving mail"
;; We don't try to move an already moved inbox.
nil
(if popmail
- (progn
- (when (and nnmail-pop-password
- (not nnmail-internal-password-cache))
- (setq nnmail-internal-password-cache nnmail-pop-password))
- (setq nnmail-internal-password (nnmail-get-password inbox))
- (nnheader-message 5 "Getting mail from the post office %s..."
- inbox))
+ (nnheader-message 5 "Getting mail from the post office %s..."
+ inbox)
(when (or (and (file-exists-p tofile)
(/= 0 (nnheader-file-size tofile)))
(and (file-exists-p inbox)
;; If getting from mail spool directory, use movemail to move
;; rather than just renaming, so as to interlock with the
;; mailer.
+ (when popmail
+ (when (and (not nnmail-internal-password-cache)
+ nnmail-pop-password)
+ (nnmail-set-password nil nnmail-pop-password))
+ (setq nnmail-internal-password (nnmail-get-password inbox)))
(unwind-protect
(save-excursion
(setq errors (generate-new-buffer " *nnmail loss*"))
(if (nnheader-functionp nnmail-movemail-program)
(condition-case err
(progn
- (funcall nnmail-movemail-program inbox tofile)
+ (funcall nnmail-movemail-program
+ inbox tofile inbox-options)
(setq result 0))
(error
(save-excursion
(set-buffer errors)
(insert (prin1-to-string err))
(setq result 255))))
- (let ((default-directory "/")
- (inbox-info (nnmail-parse-spool-file-name inbox)))
- (and popmail
- (setenv "MAILHOST"
- (nnmail-spool-mailhost inbox-info)))
- (setq result
- (apply
- 'call-process
- (append
- (list
- (expand-file-name
- nnmail-movemail-program exec-directory)
- nil errors nil
- (concat (if popmail "po:" "")
- (nnmail-spool-maildrop inbox-info))
- tofile)
- (and popmail
- nnmail-internal-password
- (list nnmail-internal-password)))))))
+ (setq result (nnmail-exec-movemail-program
+ inbox tofile popmail errors inbox-options)))
(push inbox nnmail-moved-inboxes)
(if (and (not (buffer-modified-p errors))
(zerop result))
;; No output => movemail won
(progn
- (unless popmail
+ (if popmail
+ (nnmail-set-password inbox nnmail-internal-password)
(when (file-exists-p tofile)
(set-file-modes tofile nnmail-default-file-modes))))
(set-buffer errors)
(unless (yes-or-no-p
(format "movemail: %s (%d return). Continue? "
(buffer-string) result))
- (error "%s" (buffer-string)))
- (setq tofile nil)))
- ))))
- (nnmail-set-password inbox nnmail-internal-password)
+ (error "%s" (buffer-string)))
+ (setq tofile nil))))
+ (and errors
+ (buffer-name errors)
+ (kill-buffer errors)))))
(nnheader-message 5 "Getting mail from %s...done" inbox)
- (and errors
- (buffer-name errors)
- (kill-buffer errors))
tofile))))
(defun nnmail-get-active ()
;; correct match positions.
(goto-char (match-end 0))
(let ((value (nth 1 split)))
- (re-search-backward (if (symbolp value)
- (cdr (assq value nnmail-split-abbrev-alist))
- value)
- (match-end 1)))
+ (re-search-backward
+ (concat "\\<"
+ (if (symbolp value)
+ (cdr (assq value nnmail-split-abbrev-alist))
+ value)
+ "\\>")
+ (match-end 1)))
(nnmail-split-it (nth 2 split))))
;; Not in cache, compute a regexp for the field/value pair.
'nconc
(mapcar
(lambda (file)
- (if (and (not (string-match "^po:" file))
- (file-directory-p file))
- (nnheader-directory-regular-files file)
- (list file)))
+ (let ((file-name (if (listp file) (car file) file)))
+ (if (and (not (string-match "^po:" file-name))
+ (file-directory-p file-name))
+ (nnheader-directory-regular-files file-name)
+ (list file))))
nnmail-spool-file))
procmails))
((stringp nnmail-spool-file)
"Read new incoming mail."
(let* ((spools (nnmail-get-spool-files group))
(group-in group)
- nnmail-current-spool incoming incomings spool)
+ nnmail-current-spool incoming incomings spool spool-options)
(when (and (nnmail-get-value "%s-get-new-mail" method)
nnmail-spool-file)
;; We first activate all the groups.
;; The we go through all the existing spool files and split the
;; mail from each.
(while spools
- (setq spool (pop spools))
+ (if (listp (setq spool (pop spools)))
+ (setq spool-options (cdr spool)
+ spool (car spool))
+ (setq spool-options nil))
;; We read each spool file if either the spool is a POP-mail
;; spool, or the file exists. We can't check for the
;; existence of POPped mail.
(and (file-exists-p (file-truename spool))
(> (nnheader-file-size (file-truename spool)) 0)))
(nnheader-message 3 "%s: Reading incoming mail..." method)
- (when (and (nnmail-move-inbox spool)
+ (when (and (nnmail-move-inbox spool spool-options)
(file-exists-p nnmail-crash-box))
(setq nnmail-current-spool spool)
;; There is new mail. We first find out if all this mail
his nil)))
found))
-(eval-and-compile
- (autoload 'pop3-movemail "pop3"))
-
-(defun nnmail-pop3-movemail (inbox crashbox)
+(defun nnmail-exec-movemail-program (inbox tofile popmail err-buf
+ inbox-options)
+ (let ((default-directory "/")
+ (inbox-info (nnmail-parse-spool-file-name inbox))
+ args)
+ (if popmail
+ (let ((auth-scheme (car (cdr (memq :auth-scheme inbox-options))))
+ (password
+ (or nnmail-internal-password
+ (and nnmail-movemail-program-pop-password-required
+ (nnmail-read-passwd
+ (format "Password for %s: " inbox))))))
+ (setenv "MAILHOST" (nnmail-spool-mailhost inbox-info))
+ (when password
+ (push password args))
+ (push tofile args)
+ (push (concat "po:" (nnmail-spool-maildrop inbox-info)) args)
+ (cond
+ ((or (not auth-scheme) (eq auth-scheme 'pass)))
+ ((eq auth-scheme 'apop)
+ (push nnmail-movemail-program-apop-option args))
+ (t (error "Invalid POP3 authentication scheme."))))
+ (setq args (list (nnmail-spool-maildrop inbox-info)
+ tofile)))
+ (apply
+ 'call-process
+ (expand-file-name nnmail-movemail-program exec-directory)
+ nil err-buf nil
+ args)))
+
+(eval-when-compile
+ (require 'pop3))
+
+(defun nnmail-pop3-movemail (inbox crashbox options)
"Function to move mail from INBOX on a pop3 server to file CRASHBOX."
+ (require 'pop3)
(let* ((inbox-info (nnmail-parse-spool-file-name inbox))
- (pop3-maildrop (nnmail-spool-maildrop inbox-info))
- (pop3-mailhost (nnmail-spool-mailhost inbox-info))
- (pop3-password nnmail-internal-password))
+ (pop3-maildrop (or (nnmail-spool-maildrop inbox-info)
+ pop3-maildrop))
+ (pop3-password (or nnmail-internal-password
+ pop3-password))
+ (pop3-authentication-scheme
+ (or (car (cdr (memq :auth-scheme options)))
+ pop3-authentication-scheme))
+ (pop3-mailhost (or (nnmail-spool-mailhost inbox-info)
+ pop3-mailhost))
+ (pop3-port (or (car (cdr (memq :port options)))
+ pop3-port)))
(pop3-movemail crashbox)))
(defun nnmail-within-headers-p ()
+++ /dev/null
-;; pop3-fma.el.el --- POP3 for Multiple Account for Gnus.
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. , Tatsuya Ichikawa
-;; Yasuo Okabe
-;; Author: Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
-;; Yasuo OKABE <okabe@kuis.kyoto-u.ac.jp>
-;; Version: 1.17
-;; Keywords: mail , gnus , pop3
-;;
-;; SPECIAL THANKS
-;; Keiichi Suzuki <keiichi@nanap.org>
-;; Katsumi Yamaoka <yamaoka@jpl.org>
-;;
-;; This file is not part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;
-;; Note.
-;;
-;; This file store pop3 password in variable "pop3-fma-password".
-;; Please take care by yourself to treat pop3 password.
-;;
-;; How to use.
-;;
-;; add your .emacs following codes.
-;;
-;; (require 'pop3-fma)
-;; (setq pop3-fma-spool-file-alist
-;; '(
-;; ("po:username0@mailhost0.your.domain0" pass)
-;; ("po:username1@mailhost1.your.domain1" apop)
-;; :
-;; :
-;; ))
-;;
-;; pass means normal authentication USER/PASS.
-;; apop means authentication using APOP.
-;;
-;; Variables
-;;
-;; pop3-fma-spool-file-alist ... Spool file alist of POP3 protocol
-;; pop3-fma-movemail-type ... Type of movemail program.
-;; 'lisp or 'exe
-;; 'lisp use pop3.el
-;; 'exe use movemail
-;; pop3-fma-movemail-arguments ... List of options of movemail program.
-;;
-;;; Code:
-
-(require 'cl)
-(require 'custom)
-
-(unless (and (condition-case ()
- (require 'custom)
- (file-error nil))
- (fboundp 'defgroup)
- (fboundp 'defcustom))
- (require 'backquote)
- (defmacro defgroup (&rest args))
- (defmacro defcustom (symbol value &optional doc &rest args)
- (` (defvar (, symbol) (, value) (, doc))))
- )
-
-(defgroup pop3-fma nil
- "Multile POP3 account utility for Gnus."
- :prefix "pop3-fma-"
- :group 'mail
- :group 'news)
-
-(defconst pop3-fma-version-number "1.16")
-(defconst pop3-fma-codename
-;; "J boy" ; 1.00
-;; "Blood line" ; 1.10
-;; "Star ring" ; 1.11
-;; "Goodbye Game" ; 1.12
-;; "Love is Gamble" ; 1.13
-;; "Lonely" ; 1.14
-;; "Feel the wind" ; 1.16
- "Sadness like snow" ; 1.17
- )
-(defconst pop3-fma-version (format "Multiple POP3 account utiliy for Gnus v%s - \"%s\""
- pop3-fma-version-number
- pop3-fma-codename))
-
-(defcustom pop3-fma-spool-file-alist nil
- "*Spool file to get mail using pop3 protocol.
-You should specify this variable like
- '(
- (\"po:user1@mailhost1\" type)
- (\"po:user2@mailhost2\" type)
- )
-Type must be pass or apop."
- :group 'pop3-fma
- :type 'alist)
-
-(defcustom pop3-fma-local-spool-file-alist nil
- "*List of Local spool file to get mail."
- :group 'pop3-fma
- :type 'alist)
-
-(defcustom pop3-fma-movemail-type 'lisp
- "*Type of movemail program.
-Lisp means `nnmail-movemail-program' is lisp function.
- Exe means `nnmail-movemail-program' is external program."
- :group 'pop3-fma
- :type '(choice (const lisp)
- (const exe)))
-
-(defcustom pop3-fma-movemail-arguments '("-pf")
- "*Options for movemail."
- :group 'pop3-fma
- :type '(repeat (string :tag "Argument")))
-
-(defcustom pop3-fma-save-password-information nil
- "*If non nil , save POP Server's password information.
-============== Important notice =====================
-Please take care of your password information.
-If set to t , your pop3 password is saved in pop3-fma-password in raw text.
-So , Anybody can see this information by describe-variable.
-If there is any problem , please set this variable to nil(default).
-============== Important notice ====================="
- :group 'pop3-fma
- :type 'boolean)
-
-;;; Internal variables.
-(defvar pop3-fma-password nil
- "*POP3 password , user , mailhost information for Gnus.")
-
-(defvar pop3-fma-movemail-program
- (if (eq system-type 'windows-nt)
- "movemail.exe"
- "movemail")
- "*External program name your movemail.")
-
-
-;; Temporary variable
-(defvar hdr nil)
-(defvar passwd nil)
-(defvar str nil)
-(defvar spool nil)
-(defvar movemail-output-buffer " *movemail-out*")
-(defvar pop3-fma-commandline-arguments nil)
-
-;;; To silence byte compiler
-(and
- (fboundp 'eval-when-compile)
- (eval-when-compile
- (save-excursion
- (beginning-of-defun)
- (eval-region (point-min) (point)))
- (let (case-fold-search)
- (mapcar
- (function
- (lambda (symbol)
- (unless (boundp symbol)
- (make-local-variable symbol)
- (eval (list 'setq symbol nil)))))
- '(:group
- :prefix :type
- pop3-maildrop
- pop3-mailhost
- ))
- (make-local-variable 'byte-compile-warnings)
- (setq byte-compile-warnings nil))))
-
-(defun pop3-fma-init-message-hook ()
- (add-hook 'message-send-hook 'pop3-fma-message-add-header))
-
-(eval-after-load "message"
- '(pop3-fma-init-message-hook))
-
-(add-hook 'gnus-after-exiting-gnus-hook
- '(lambda () (setq pop3-fma-password nil)))
-(add-hook 'gnus-before-startup-hook 'pop3-fma-set-pop3-password)
-
-;;
-;;
-;; Gnus POP3 additional utility...
-;;
-(defun pop3-fma-movemail (inbox crashbox)
- "Function to move mail from INBOX on a pop3 server to file CRASHBOX."
- (if (string-match "^po:" inbox)
- (progn
- (if (and pop3-fma-save-password-information
- (not pop3-fma-password))
- (pop3-fma-set-pop3-password))
- (let ((pop3-maildrop
- (substring inbox (match-end (string-match "^po:" inbox))
- (- (match-end (string-match "^.*@" inbox)) 1)))
- (pop3-mailhost
- (substring inbox (match-end (string-match "^.*@" inbox))))
- (pop3-password
- (if (and pop3-fma-save-password-information
- pop3-fma-password)
- (pop3-fma-read-passwd (substring inbox (match-end (string-match "^.*@" inbox))))
- (pop3-fma-input-password
- (substring inbox (match-end (string-match "^.*@" inbox)))
- (substring inbox (match-end (string-match "^po:" inbox))
- (- (match-end (string-match "^.*@" inbox)) 1)))))
- (pop3-authentication-scheme
- (nth 1 (assoc inbox pop3-fma-spool-file-alist))))
-;; (pop3-fma-movemail-type (pop3-fma-get-movemail-type inbox)))
- (if (eq pop3-authentication-scheme 'pass)
- (message "Checking new mail user %s at %s using USER/PASS ..." pop3-maildrop pop3-mailhost)
- (message "Checking new mail user %s at %s using APOP ..." pop3-maildrop pop3-mailhost))
- (if (eq pop3-fma-movemail-type 'exe)
- (progn
- (setenv "MAILHOST" pop3-mailhost)
- (if (and (not (memq pop3-password pop3-fma-commandline-arguments))
- (not (memq (concat "po:" pop3-maildrop) pop3-fma-commandline-arguments)))
- (progn
- (if (eq pop3-authentication-scheme 'apop)
- (setq pop3-fma-commandline-arguments
- (append
- pop3-fma-movemail-arguments
- (list
- "-A"
- (concat "po:" pop3-maildrop)
- crashbox
- pop3-password)))
- (setq pop3-fma-commandline-arguments
- (append
- pop3-fma-movemail-arguments
- (list
- (concat "po:" pop3-maildrop)
- crashbox
- pop3-password))))))
- (if (not (get-buffer movemail-output-buffer))
- (get-buffer-create movemail-output-buffer))
- (set-buffer movemail-output-buffer)
- (erase-buffer)
- (apply 'call-process (concat
- exec-directory
- pop3-fma-movemail-program)
- nil movemail-output-buffer nil
- pop3-fma-commandline-arguments)
- (let ((string (buffer-string)))
- (if (> (length string) 0)
- (progn
- (if (y-or-n-p
- (concat (substring string 0
- (- (length string) 1))
- " continue ??"))
- nil
- nil)))))
- (pop3-movemail crashbox))))
- (message "Checking new mail at %s ... " inbox)
- (call-process (concat exec-directory pop3-fma-movemail-program)
- nil
- nil
- nil
- inbox
- crashbox)
- (message "Checking new mail at %s ... done." inbox)))
-;;
-;;
-(defun pop3-fma-read-passwd (mailhost)
- (setq passwd (nth 2 (assoc mailhost pop3-fma-password)))
- passwd)
-
-(defun pop3-fma-input-password (mailhost maildrop)
- (pop3-fma-read-noecho
- (format "POP Password for %s at %s: " maildrop mailhost) t))
-
-(setq pop3-read-passwd 'pop3-fma-read-passwd
- nnmail-read-passwd 'pop3-fma-read-passwd)
-;;
-;; Set multiple pop3 server's password
-(defun pop3-fma-store-password (passwd)
- (interactive
- (list (pop3-fma-read-noecho
- (format "POP Password for %s at %s: " pop3-maildrop pop3-mailhost) t)))
- (if (not (assoc pop3-mailhost pop3-fma-password))
- (setq pop3-fma-password
- (append pop3-fma-password
- (list
- (list
- pop3-mailhost
- pop3-maildrop
- passwd)))))
- (setcar (cdr (cdr (assoc pop3-mailhost pop3-fma-password)))
- passwd)
- (message "POP password registered.")
- passwd)
-;;
-;;;###autoload
-(defun pop3-fma-set-pop3-password()
- (interactive)
- (if pop3-fma-save-password-information
- (progn
- (mapcar
- (lambda (x)
- (let ((pop3-maildrop
- (substring (car x) (match-end (string-match "^po:" (car x)))
- (- (match-end (string-match "^.*@" (car x))) 1)))
- (pop3-mailhost
- (substring (car x) (match-end (string-match "^.*@" (car x))))))
- (call-interactively 'pop3-fma-store-password)))
- pop3-fma-spool-file-alist)))
- (setq nnmail-movemail-program 'pop3-fma-movemail)
-;; (setq nnmail-spool-file pop3-fma-spool-file-alist))
- (setq nnmail-spool-file (append
- pop3-fma-local-spool-file-alist
- (mapcar
- (lambda (spool)
- (car spool))
- pop3-fma-spool-file-alist))))
-;;
-(defmacro pop3-fma-read-char-exclusive ()
- (cond ((featurep 'xemacs)
- '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
- (left . ?\C-h))))
- event key)
- (while (not
- (and
- (key-press-event-p (setq event (next-command-event)))
- (setq key (or (event-to-character event)
- (cdr (assq (event-key event) table)))))))
- key))
- ((fboundp 'read-char-exclusive)
- '(read-char-exclusive))
- (t
- '(read-char))))
-;;
-(defun pop3-fma-read-noecho (prompt &optional stars)
- "Read a single line of text from user without echoing, and return it.
-Argument PROMPT ."
- (let ((ans "")
- (c 0)
- (echo-keystrokes 0)
- (cursor-in-echo-area t)
- (log-message-max-size 0)
- message-log-max done msg truncate)
- (while (not done)
- (if (or (not stars) (string-equal "" ans))
- (setq msg prompt)
- (setq msg (concat prompt (make-string (length ans) ?*)))
- (setq truncate
- (1+ (- (length msg) (window-width (minibuffer-window)))))
- (and (> truncate 0)
- (setq msg (concat "$" (substring msg (1+ truncate))))))
- (message msg)
- (setq c (pop3-fma-read-char-exclusive))
- (cond ((eq ?\C-g c)
- (setq quit-flag t
- done t))
- ((memq c '(?\r ?\n ?\e))
- (setq done t))
- ((eq ?\C-u c)
- (setq ans ""))
- ((and (/= ?\b c) (/= ?\177 c))
- (setq ans (concat ans (char-to-string c))))
- ((> (length ans) 0)
- (setq ans (substring ans 0 -1)))))
- (if quit-flag
- (prog1
- (setq quit-flag nil)
- (message "Quit")
- (beep t))
- (message "")
- ans)))
-;;
-;;
-(defun pop3-fma-message-add-header ()
- (if (message-mail-p)
- (pop3-fma-add-custom-header "X-Ya-Pop3:" pop3-fma-version)))
-
-;;
-;; Add your custom header.
-(defun pop3-fma-add-custom-header (header string)
- (let ((delimline
- (progn (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (point-marker))))
- (goto-char (point-min))
- (or (re-search-forward (concat "^" header) delimline t)
- (progn
- (goto-char delimline)
- (forward-line -1)
- (beginning-of-line)
- (setq hdr (concat header " "))
- (setq str (concat hdr string))
- (setq hdr (concat str "\n"))
- (insert-string hdr)))))
-;;
-;;
-(defun pop3-fma-get-movemail-type (inbox)
- (if (eq (nth 1 (assoc inbox pop3-fma-spool-file-alist)) 'apop)
- 'lisp
- pop3-fma-movemail-type))
-;;
-(provide 'pop3-fma)
-;;
-;; pop3-fma.el ends here.
-
-
Defaults to 'pass, for the standard USER/PASS authentication. Other valid
values are 'apop.")
-(defvar pop3-authentication-scheme-alist nil
- "*Alist of host and POP3 authentication scheme.")
-
(defvar pop3-timestamp nil
"Timestamp returned when initially connected to the POP server.
Used for APOP authentication.")
(let* ((process (pop3-open-server pop3-mailhost pop3-port))
(crashbuf (get-buffer-create " *pop3-retr*"))
(n 1)
- message-count
- (pop3-password pop3-password)
- (pop3-authentication-scheme pop3-authentication-scheme)
- )
+ message-count)
;; for debugging only
(if pop3-debug (switch-to-buffer (process-buffer process)))
;; query for password
(if (and pop3-password-required (not pop3-password))
(setq pop3-password
(pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
- (let ((tmp-scheme (cdr (assoc pop3-mailhost
- pop3-authentication-scheme-alist))))
- (when tmp-scheme
- (setq pop3-authentication-scheme tmp-scheme)))
(cond ((equal 'apop pop3-authentication-scheme)
(pop3-apop process pop3-maildrop))
((equal 'pass pop3-authentication-scheme)
projects / elisp / gnus.git- / commitdiff