X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-offline.el;h=568e2c534598c6e94f4cb9d8d35160db86f39565;hb=9a3b6b92b8813b40f097c7758dcfd5a28338bb79;hp=4705ecf14f4ef22f7afd7d0513c6012a73227a4e;hpb=fe0ce09c86be123adec806fbd1b865b6df3e9be3;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-offline.el b/lisp/gnus-offline.el index 4705ecf..568e2c5 100644 --- a/lisp/gnus-offline.el +++ b/lisp/gnus-offline.el @@ -1,12 +1,14 @@ ;;; gnus-offline.el --- To process mail & news at offline environment. +;;; $Id: gnus-offline.el,v 1.1.2.5.2.28 1999-01-31 23:06:20 yamaoka Exp $ ;;; Copyright (C) 1998 Tatsuya Ichikawa ;;; Yukihiro Ito ;;; Author: Tatsuya Ichikawa ;;; Yukihiro Ito ;;; Hidekazu Nakamura +;;; Tsukamoto Tetsuo -;;; Version: 1.51 +;;; Version: 2.10 ;;; Keywords: news , mail , offline , gnus ;;; ;;; SPECIAL THANKS @@ -40,39 +42,49 @@ ;;; You must use Semi-gnus 6.X.X. ;;; ;;; How to use. -;;; put following code in you .emacs , after the setting of Gnus. ;;; -;;; (setq gnus-offline-connect-program "/dir/program.exe") -;;; (setq gnus-offline-connect-program-arguments '("-a" "-b")) -;;; (setq gnus-offline-hangup-program "/dir/program") -;;; (setq gnus-offline-hangup-program-arguments '("-c" "-d")) -;;; (setq gnus-offline-mail-spool-directory "your-send-mail-spool-directory") -;;; (setq gnus-offline-news-spool-directory "your-send-news-spool-directory") -;;; (autoload 'gnus-offline-setup "gnus-offline") -;;; (add-hook 'gnus-load-hook 'gnus-offline-setup) +;;; Add following code at the end in your .emacs +;;; +;;; (load "gnus-ofsetup") +;;; (gnus-setup-for-offline) +;;; (load gnus-offline-setting-file) ;;; ;;; If you use gnus-agent as souper , put gnus-agent setup code in you .gnus.el ;;; ;;; If you use nnspool as souper , put following code in your .emacs before ;;; gnus-offline setting. ;;; -;;; (load "miee") -;;; (message-offline-state) -;;; ;;; Then , put hang.exe in exec-path directory. ;;; ;;; 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-connect-program ... Dialup program name. -;;; gnus-offline-connect-program-arguments +;;; gnus-offline-dialup-program-arguments ;;; ... List of dialup program arguments. -;;; gnus-offline-hangup-program ... Program name that used hanup line. ;;; gnus-offline-hangup-program-arguments ;;; ... List of hangup program arguments. -;;; gnus-offline-mail-spool-directory... spool directory sending mail. -;;; gnus-offline-news-spool-directory... spool directory sending news. ;;; gnus-offline-mail-treat-environ ... toggle sending mail online/offline. ;;; gnus-offline-articles-to-fetch ... toggle fetch articles. ;;; both->mail->news->both... @@ -81,14 +93,11 @@ ;;; gnus-offline-after-online-hook ... hook after all online jobs. ;;; gnus-offline-interval-time ... Interval time to do all online jobs. ;;; (minutes) -;;; gnus-offline-MTA-type ... Type of MTA. -;;; 'smtp ... Use smtp.el. -;;; 'sendmail ... Use sendmail.el. -;;; gnus-offline-drafts-queue-type ... Method type queuing message to spool. -;;; 'miee means queue message to spool -;;; using miee.el. -;;; 'agent means queue message to spool -;;; using gnus-agent.el. +;;; 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: @@ -96,7 +105,7 @@ (require 'cl) (require 'custom) -(require 'pop3-fma) +(require 'easymenu) (unless (and (condition-case () (require 'custom) @@ -114,45 +123,24 @@ :group 'mail :group 'news) -(defconst gnus-offline-version-number "1.51") +(defconst gnus-offline-version-number "2.10b1") (defconst gnus-offline-codename -;; "You may be right" ; 1.40 -;; "Chilstie Lee" ; 1.45 -;; "Uptown Girl" ; 1.46 -;; "Easy money" ; 1.47 -;; "An Innocent man" ; 1.48 -;; "Tell her about it" ; 1.50 - "This night" ; 1.51 -;; "Movin'out" -;; "Longest night" -;; "Leave a tender moment alone" -;; "Back in the U.S.S.R" -;; "Running on ice" -;; "This is the time" +;; "Beta5" ; Beta +;; "This is the time" ; 2.00 ;; "A matter of trust" ;; "Modern Woman" + "Ahhhhhhh!!" ; 2.10b1 ;; "Code of silence" ) (defconst gnus-offline-version (format "Gnus offline backend utiliy v%s" gnus-offline-version-number)) -(defcustom gnus-offline-connect-program nil - "*Program name to dial-up dialup network. -If nil , use auto-dialup if required to connect the Internet." - :group 'gnus-offline - :type 'string) - -(defcustom gnus-offline-connect-program-arguments nil - "*Program arguments of gnus-offline-connect-program." +(defcustom gnus-offline-dialup-program-arguments nil + "*Program arguments of gnus-offline-dialup-program." :group 'gnus-offline :type '(repeat (string :tag "Argument"))) -(defcustom gnus-offline-hangup-program nil - "*Program name to hang-up dialup network." - :group 'gnus-offline - :type 'string) - (defcustom gnus-offline-hangup-program-arguments nil "*Program arguments of gnus-offline-hangup-program." :group 'gnus-offline @@ -163,20 +151,11 @@ If nil , use auto-dialup if required to connect the Internet." :group 'gnus-offline :type 'boolean) -(defcustom gnus-offline-mail-spool-directory "~/News/mail.out" - "*Spool directory sending mail." - :group 'gnus-offline - :type 'directory) - -(defcustom gnus-offline-news-spool-directory "~/News/news.out" - "*Spool directory sending news." - :group 'gnus-offline - :type 'directory) - (defcustom gnus-offline-load-hook nil "*Hook to be run after the gnus-offline package has been loaded." :group 'gnus-offline :type 'hook) + (defcustom gnus-offline-before-online-hook nil "*Hook to be run before all online jobs." :group 'gnus-offline @@ -214,22 +193,6 @@ If set to 0 , timer call is disabled." :group 'gnus-offline :type 'integer) -(defcustom gnus-offline-MTA-type 'smtp - "*Type of MTA program. -smtp means use smtp.el. - sendmail means use sendmail.el." - :group 'gnus-offline - :type '(choice (const smtp) - (const sendmail))) - -(defcustom gnus-offline-drafts-queue-type 'miee - "*Type of to queue drafts method. -'miee means drafts are queued and sent by miee.el. -'agent means drafts are queued and sent by gnus-agent.el" - :group 'gnus-offline - :type '(choice (const miee) - (const agent))) - (defcustom gnus-offline-after-empting-spool-hook nil "*Hook to be run before empting spool." :group 'gnus-offline @@ -250,6 +213,23 @@ smtp means use smtp.el. :group 'gnus-offline :type 'function) +(defcustom gnus-offline-pop-password-file nil + "*File name for saving one's POP password information. +This variable should be nil if there's some possibility that +your passwords be stolen." + :group 'gnus-offline + :type '(choice (file :tag "File") + (const nil))) + +(defcustom gnus-offline-pop-password-decoding-function + (function (lambda () (base64-decode-region (point-min) (point-max)))) + "*Function for decoding one's password information. +The value has no effect when `gnus-offline-pop-password-file' +is nil. +This variable might be nil if you don't need to encode your passwords." + :group 'gnus-offline + :type 'function) + ;;; Internal variables. (defvar gnus-offline-connected nil "*If value is t , dialup line is connected status. @@ -267,94 +247,118 @@ If value is nil , dialup line is disconnected status.") gnus-offline-codename) "*Header string for gnus-offline.") -(defvar gnus-offline-auto-hangup-indicator "Hup" - "*Indicator whether auto hang up is enabled.") - (defvar gnus-offline-stored-group-level nil "*Mail Group level before changing.") (defvar gnus-offline-movemail-arguments nil "*All command line arguments of exec-directory/movemail.") +(defvar gnus-offline-mail-source nil + "*nnmail-spool-file save variable.") + ;;; Temporary variable: (defvar string) (defvar hdr) (defvar str) +(defvar ver) (defvar passwd) (defvar num) +(defvar gnus-offline-error-buffer " *Error*") (defvar gnus-offline-map (make-sparse-keymap)) -(autoload 'message-offline-state "miee" - "Set current status to offline state" t) -;; -;; mode-line control -(if (not (member 'gnus-offline-auto-hangup-indicator mode-line-format)) - (progn - (delete "-%-" mode-line-format) - (setq-default mode-line-format - (append mode-line-format - (list "--" 'gnus-offline-auto-hangup-indicator - "-%-"))))) +;;; 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)))) + (put 'gnus-offline-set-unplugged-state 'menu-enable 'gnus-offline-connected) -(add-hook 'gnus-startup-hook 'gnus-offline-setup) +(if (eq system-type 'windows-nt) + (define-process-argument-editing "/hang\\.exe\\'" + (lambda (x) (general-process-argument-editing-function + x nil t t nil t t)))) ;;; Functions ;; ;; Setting up... ;; (defun gnus-offline-setup () "*Initialize gnus-offline function" - (if (eq system-type 'windows-nt) - (define-process-argument-editing "/hang\\.exe\\'" - (lambda (x) (general-process-argument-editing-function - x nil t t nil t t)))) - ;; Initialize Internal Variable - (gnus-offline-initialize-variables) - - ;; Disable fetch mail when startup. - (gnus-offline-disable-fetch-mail) + + ;; Load setting file - required. + (load gnus-offline-setting-file) + + ;; Menu and keymap + (gnus-offline-define-menu-and-key) ;; To transfer Mail/News function. (cond ((eq gnus-offline-mail-treat-environ 'offline) - ;; send mail under online environ. + ;; send mail under offline environ. (gnus-offline-set-offline-sendmail-function)) ((eq gnus-offline-mail-treat-environ 'online) ;; send mail under offline environ. - (gnus-offline-set-online-sendmail-function))) - - ;; always treat news under offline environ. - (gnus-offline-set-offline-post-news-function) - - ;; Spool directory setting - Miee - (if (eq gnus-offline-drafts-queue-type 'miee) - (setq sendmail-to-spool-directory gnus-offline-mail-spool-directory - news-spool-request-post-directory gnus-offline-news-spool-directory)) - - ;; When startup ... state is offline. - (setq gnus-nntp-service nil - gnus-nntp-server nil) - - ;; Setup needed Hooks - (gnus-offline-setup-needed-hooks)) -;; -;; -(defun gnus-offline-initialize-variables () - "*Initialize gnus-offline internal variable." - (if (featurep 'nnmail) - (setq gnus-offline-mail-fetch-method 'nnmail)) - (if (featurep 'gnus-agent) - (setq gnus-offline-news-fetch-method 'nnagent)) - (if (featurep 'nnspool) - (setq gnus-offline-news-fetch-method 'nnspool)) - (if (eq gnus-offline-drafts-queue-type 'miee) - (load "miee")) - (gnus-offline-define-menu-and-key)) + (gnus-offline-set-online-sendmail-function)))) +;; (add-hook 'gnus-group-mode-hook 'gnus-offline-setup)) + +;; +;; Setting Error check. +(defun gnus-offline-error-check () + ;; Check gnus-agent and nnspool setting. + (cond ((eq gnus-offline-news-fetch-method 'nnagent) + ;; nnagent and gnus-agent loaded ?? + (if (not (and (featurep 'gnus-agent) + (featurep 'nnagent))) + (progn + (get-buffer-create gnus-offline-error-buffer) + (set-buffer gnus-offline-error-buffer) + (erase-buffer) + (insert "WARNING!!: gnus-agent.el or nnagent.el is not loaded.\n") + (insert "Please check your .emacs or .gnus.el to work gnus-agent fine.") + (pop-to-buffer gnus-offline-error-buffer)))) + + ((eq gnus-offline-news-fetch-method 'nnspool) + (if (not (featurep 'nnspool)) + (progn + (get-buffer-create gnus-offline-error-buffer) + (set-buffer gnus-offline-error-buffer) + (erase-buffer) + (insert "WARNING!!: nnspool.el is not loaded.\n") + (insert "Please check your .emacs or .gnus.el to work nnspool fine.") + (pop-to-buffer gnus-offline-error-buffer)))))) ;; ;; (defun gnus-offline-set-offline-sendmail-function () "*Initialize sendmail-function when unplugged status." (if (eq gnus-offline-drafts-queue-type 'miee) - (setq message-send-mail-function 'sendmail-to-spool-in-gnspool-format) - (setq message-send-mail-function 'gnus-agent-send-mail))) + (progn + (if (eq gnus-offline-news-fetch-method 'nnagent) + (setq gnus-agent-send-mail-function 'sendmail-to-spool-in-gnspool-format)) + (setq message-send-mail-function 'sendmail-to-spool-in-gnspool-format)) + (setq gnus-agent-send-mail-function (gnus-offline-set-online-sendmail-function) + message-send-mail-function 'gnus-agent-send-mail))) ;; (defun gnus-offline-set-online-sendmail-function () "*Initialize sendmail-function when plugged status." @@ -371,39 +375,51 @@ If value is nil , dialup line is disconnected status.") "*Initialize sendnews-function when plugged status." (setq message-send-news-function 'message-send-news-with-gnus)) ;; -(defun gnus-offline-setup-needed-hooks () - "*Initialize needed hooks for gnus-offline." - (add-hook 'gnus-group-mode-hook 'gnus-offline-processed-by-timer) - (add-hook 'gnus-after-getting-new-news-hook 'gnus-offline-after-get-new-news) - (add-hook 'gnus-after-getting-news-hook 'gnus-offline-after-get-new-news) - (if (eq gnus-offline-news-fetch-method 'nnspool) - (add-hook 'after-getting-news-hook 'gnus-offline-nnspool-hangup-line)) - (add-hook 'message-send-hook 'gnus-offline-message-add-header) - (if (featurep 'pop3-fma) - (add-hook 'message-send-hook 'pop3-fma-message-add-header))) -;; ;; Get new news jobs. (gnus-agent and nnspool) ;; (defun gnus-offline-gnus-get-new-news (&optional arg) - "*Override function \"gnus-grou-get-new-news\"." + "*Override function \"gnus-group-get-new-news\"." (interactive "P") (run-hooks 'gnus-offline-before-online-hook) (if (functionp gnus-offline-dialup-function) (funcall gnus-offline-dialup-function)) (gnus-offline-get-new-news-function) - (gnus-group-get-new-news arg)) + (if (not (locate-library "mail-source")) + (progn + (let (buffer) + (unwind-protect + (progn + (save-excursion + (or pop3-fma-password + (when gnus-offline-pop-password-file + (setq pop3-fma-save-password-information t) + (setq buffer (get-buffer-create "*offline-temp*")) + (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)) + (when gnus-offline-pop-password-file + (setq pop3-fma-password nil) + (setq pop3-fma-save-password-information nil) + (kill-buffer buffer))))) + ;; + ;; Use mail-source.el + (gnus-group-get-new-news arg))) ;; ;; dialup... ;; (defun gnus-offline-connect-server () "*Dialup function." - ;; Dialup if gnus-offline-connect-program is specified - (if (stringp gnus-offline-connect-program) + ;; Dialup if gnus-offline-dialup-program is specified + (if (stringp gnus-offline-dialup-program) (progn (message "Dialing ...") - (apply 'call-process gnus-offline-connect-program nil nil nil - gnus-offline-connect-program-arguments) + (apply 'call-process gnus-offline-dialup-program nil nil nil + gnus-offline-dialup-program-arguments) (sleep-for 1) (message "Dialing ... done.")))) @@ -416,11 +432,6 @@ If value is nil , dialup line is disconnected status.") (if (eq gnus-offline-articles-to-fetch 'mail) (gnus-offline-set-mail-group-level gnus-offline-mail-group-level)) - ;; Re initialize internal variable...if failed. - (if (or (not gnus-offline-mail-fetch-method) - (not gnus-offline-news-fetch-method)) - (gnus-offline-initialize-variables)) - ;; Set to online environ. (setq gnus-offline-connected t) @@ -439,9 +450,9 @@ If value is nil , dialup line is disconnected status.") (gnus-offline-enable-fetch-mail)) ;; fetch only mail for gnus-agent - (if (eq gnus-offline-news-fetch-method 'nnagent) - (if (eq gnus-offline-articles-to-fetch 'mail) - (setq gnus-agent-handle-level gnus-offline-mail-group-level)))) + (if (and (eq gnus-offline-news-fetch-method 'nnagent) + (eq gnus-offline-articles-to-fetch 'mail)) + (setq gnus-agent-handle-level gnus-offline-mail-group-level))) ;; ;; Change mail group level to handle only mail. @@ -503,42 +514,46 @@ If value is nil , dialup line is disconnected status.") (if (memq gnus-offline-articles-to-fetch '(both news)) (progn (if gnus-offline-connected - (progn - (if (eq gnus-offline-news-fetch-method 'nnagent) - (progn - ;; Get New News (gnus-agent) - (gnus-agent-toggle-plugged t) - - ;; fetch articles - (gnus-agent-fetch-session) - - ;; Hang Up line. then set to offline status. - (if (and gnus-offline-connected - gnus-offline-auto-hangup) - (gnus-offline-set-unplugged-state)) - - ;; All online jobs has done. - (gnus-offline-after-jobs-done))) - (if (eq gnus-offline-news-fetch-method 'nnspool) - ;; Get New News (nnspool) - (gnspool-get-news))))))) + (cond ((eq gnus-offline-news-fetch-method 'nnagent) + ;; Get New News (gnus-agent) + (gnus-agent-toggle-plugged t) + + ;; fetch articles + (gnus-agent-fetch-session) + + ;; Hang Up line. then set to offline status. + (if (and gnus-offline-connected + gnus-offline-auto-hangup) + (gnus-offline-set-unplugged-state)) + + ;; All online jobs has done. + (gnus-offline-after-jobs-done)) + (t + (if (eq gnus-offline-news-fetch-method 'nnspool) + ;; Get New News (nnspool) + (gnspool-get-news)))))))) ;; ;; Disable fetch mail ;; (defun gnus-offline-disable-fetch-mail () "*Set do not fetch mail." - (if (eq gnus-offline-mail-fetch-method 'nnmail) - (setq nnmail-spool-file nil))) + (setq nnmail-spool-file nil)) ;; ;; Enable fetch mail ;; (defun gnus-offline-enable-fetch-mail () "*Set to fetch mail." - (if (eq gnus-offline-mail-fetch-method 'nnmail) + (setq gnus-offline-mail-fetch-method 'nnmail) + (if (not (locate-library "mail-source")) (progn - (setq gnus-offline-mail-fetch-method 'nnmail) (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)))) + (setq nnmail-spool-file gnus-offline-mail-source))) ;; ;; Enable fetch news ;; @@ -577,10 +592,10 @@ If value is nil , dialup line is disconnected status.") (if (eq gnus-offline-mail-treat-environ 'offline) (progn (if (eq gnus-offline-news-fetch-method 'nnagent) - (setq str (format "\n with %s" nnagent-version) - string (concat gnus-offline-header-string str)) - (setq str (format "\n with %s" nnspool-version) - string (concat gnus-offline-header-string str))) + (setq ver nnagent-version) + (setq ver nnspool-version)) + (setq str (format "\n with %s" ver) + string (concat gnus-offline-header-string str)) (gnus-offline-add-custom-header "X-Gnus-Offline-Backend:" string)))) @@ -609,7 +624,8 @@ If value is nil , dialup line is disconnected status.") (if (functionp gnus-offline-hangup-function) (funcall gnus-offline-hangup-function)) (setq gnus-offline-connected nil) - (gnus-agent-toggle-plugged nil) + (if (eq gnus-offline-news-fetch-method 'nnagent) + (gnus-agent-toggle-plugged nil)) ;; Set send mail/news function to offline functions. (gnus-offline-set-offline-sendmail-function) @@ -643,9 +659,14 @@ If value is nil , dialup line is disconnected status.") (if (eq gnus-offline-articles-to-fetch 'mail) (gnus-offline-restore-mail-group-level)) (if (eq gnus-offline-news-fetch-method 'nnagent) - (gnus-offline-agent-expire)) - (ding) - (message "All online jobs have done.")) + (or gnus-agent-expire-all + (gnus-offline-agent-expire))) + (if (and (featurep 'xemacs) + (fboundp 'play-sound-file)) + (ding nil 'drum) + (ding)) + (gnus-group-save-newsrc) + (message "All online jobs has done.")) ;; @@ -658,10 +679,8 @@ If value is nil , dialup line is disconnected status.") (if gnus-offline-auto-hangup (progn (setq gnus-offline-auto-hangup nil - gnus-offline-auto-hangup-indicator "Con" str "disabled.")) (setq gnus-offline-auto-hangup t - gnus-offline-auto-hangup-indicator "Hup" str "enabled.")) (message (format "%s %s" string str))) ;; @@ -771,12 +790,15 @@ If value is nil , dialup line is disconnected status.") (defun gnus-offline-define-menu-and-key () "*Set key and menu." (if (eq gnus-offline-drafts-queue-type 'miee) - (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-miee) + (if (featurep 'xemacs) + (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-miee) + (gnus-offline-define-menu-on-miee)) (add-hook 'gnus-group-mode-hook 'gnus-offline-define-menu-on-agent)) (add-hook 'gnus-group-mode-hook '(lambda () (local-set-key "\C-coh" 'gnus-offline-set-unplugged-state) - (local-set-key "\C-com" 'gnus-offline-toggle-movemail-program) + (if (not (locate-library "mail-source")) + (local-set-key "\C-com" 'gnus-offline-toggle-movemail-program)) (local-set-key "\C-cof" 'gnus-offline-toggle-articles-to-fetch) (local-set-key "\C-coo" 'gnus-offline-toggle-on/off-send-mail) (local-set-key "\C-cox" 'gnus-offline-toggle-auto-hangup) @@ -789,163 +811,127 @@ If value is nil , dialup line is disconnected status.") (substitute-key-definition 'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged gnus-agent-group-mode-map) - (local-set-key "\C-coe" 'gnus-offline-agent-expire))))) + (local-set-key "\C-coe" 'gnus-offline-agent-expire))) + (or (featurep 'xemacs) + (define-key gnus-group-mode-map + (if (eq system-type 'windows-nt) [S-mouse-2] [mouse-3]) + 'gnus-offline-popup-menu)))) (if (eq gnus-offline-news-fetch-method 'nnagent) (add-hook 'gnus-summary-mode-hook '(lambda () (substitute-key-definition 'gnus-agent-toggle-plugged 'gnus-offline-toggle-plugged - gnus-agent-summary-mode-map))))) - + gnus-agent-summary-mode-map)))) + (if (featurep 'xemacs) + ;; Overwrite the toolbar spec for gnus-group-mode. + (add-hook 'gnus-startup-hook + (lambda () + (let ((i 0) (stat t) but) + (while (and stat (setq but (nth i gnus-group-toolbar))) + (and (equal 'gnus-group-get-new-news (aref but 1)) + (aset but 1 'gnus-offline-gnus-get-new-news) + (setq stat nil)) + (setq i (1+ i)))))))) +;; +;; (defun gnus-offline-define-menu-on-miee () - "*Set menu bar on MIEE menu." - (global-set-key - [menu-bar - miee - gnus-offline-hup-separator] - '("--")) - - (global-set-key - [menu-bar - miee - gnus-offline] - (cons "Gnus Offline Utility" - (make-sparse-keymap "Gnus Offline Utiliry"))) - - (if (featurep 'pop3-fma) - (global-set-key - [menu-bar - miee - gnus-offline - gnus-offline-toggle-movemail-program] - '("Toggle movemail program" . - gnus-offline-toggle-movemail-program))) - - (global-set-key - [menu-bar - miee - gnus-offline - gnus-offline-toggle-articles-to-fetch] - '("Toggle articles to fetch" . - gnus-offline-toggle-articles-to-fetch)) - - (global-set-key - [menu-bar - miee - gnus-offline - gnus-offline-toggle-on/off-send-mail] - '("Toggle online/offline send mail" . - gnus-offline-toggle-on/off-send-mail)) - - (global-set-key - [menu-bar - miee - gnus-offline - gnus-offline-toggle-auto-hangup] - '("Toggle auto hang up" . gnus-offline-toggle-auto-hangup)) - - (global-set-key - [menu-bar - miee - gnus-offline - gnus-offline-expire-separator] - '("--")) - - (if (eq gnus-offline-news-fetch-method 'nnagent) - (global-set-key - [menu-bar - miee - gnus-offline - gnus-offline-agent-expire] - '("Expire articles" . gnus-offline-agent-expire))) - - (global-set-key - [menu-bar - miee - gnus-offline - gnus-offline-set-interval-time] - '("Set interval time." . gnus-offline-set-interval-time)) - - (global-set-key - [menu-bar - miee - gnus-offline - gnus-offline-hup-separator] - '("--")) - - (global-set-key - [menu-bar - miee - gnus-offline - gnus-offline-set-unplugged-state] - '("Hang Up Line." . gnus-offline-set-unplugged-state))) + "*Set and change menu bar on MIEE menu." + (let ((menu + (if (featurep 'meadow) + (easy-menu-change + nil + "Miee" + '( + ["Spool にある記事の送信" news-spool-post t] + ["Spool にある Mail の送信" mail-spool-send t] + "----" + ["Offline 状態へ" message-offline-state (not message-offline-state)] + ["Online 状態へ" message-online-state message-offline-state] + "----" + ("Gnus Offline" + ["movemail の切替え" gnus-offline-toggle-movemail-program + (not (locate-library "mail-source"))] + ["取得記事種類の変更" gnus-offline-toggle-articles-to-fetch t] + ["Mail 送信方法(On/Off)の切替え" gnus-offline-toggle-on/off-send-mail t] + ["自動切断の切替え" gnus-offline-toggle-auto-hangup t] + "----" + ["取得済記事を消す" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)] + ["記事取得間隔時間の設定" gnus-offline-set-interval-time t] + "----" + ["回線の切断" gnus-offline-set-unplugged-state gnus-offline-connected]) + )) + (easy-menu-change + nil + "Miee" + '( + ["Post news in spool" news-spool-post t] + ["Send mails in spool" mail-spool-send t] + "----" + ["Message Offline" message-offline-state (not message-offline-state)] + ["Message Online" message-online-state message-offline-state] + "----" + ("Gnus Offline" + ["Toggle movemail program" gnus-offline-toggle-movemail-program + (not (locate-library "mail-source"))] + ["Toggle articles to fetch" gnus-offline-toggle-articles-to-fetch t] + ["Toggle online/offline send mail" gnus-offline-toggle-on/off-send-mail t] + ["Toggle auto hangup" gnus-offline-toggle-auto-hangup t] + "----" + ["Expire articles" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)] + ["Set interval time" gnus-offline-set-interval-time t] + "----" + ["Hang up Line." gnus-offline-set-unplugged-state gnus-offline-connected] + )))))) + (and (featurep 'xemacs) + (easy-menu-add menu)))) ;; ;; define menu without miee. ;; (defun gnus-offline-define-menu-on-agent () "*Set menu bar on OFFLINE menu." - (define-key-after - (lookup-key global-map [menu-bar]) - [offline] - (cons "Offline" (make-sparse-keymap "Offline")) - 'help) ;; Actually this adds before "Help". - - (if (featurep 'pop3-fma) - (global-set-key - [menu-bar - offline - gnus-offline-toggle-movemail-program] - '("Toggle movemail program" . gnus-offline-toggle-movemail-program))) - - (global-set-key - [menu-bar - offline - gnus-offline-toggle-articles-to-fetch] - '("Toggle articles to fetch" . gnus-offline-toggle-articles-to-fetch)) - - (global-set-key - [menu-bar - offline - gnus-offline-toggle-on/off-send-mail] - '("Toggle online/offline send mail" . gnus-offline-toggle-on/off-send-mail)) - - (global-set-key - [menu-bar - offline - gnus-offline-toggle-auto-hangup] - '("Toggle auto hang up" . gnus-offline-toggle-auto-hangup)) - - (global-set-key - [menu-bar - offline - gnus-offline-separator] - '("--")) - - (if (eq gnus-offline-news-fetch-method 'nnagent) - (progn - (global-set-key - [menu-bar - offline - gnus-offline-agent-expire] - '("Expire articles" . gnus-offline-agent-expire)))) - - (global-set-key - [menu-bar - offline - gnus-offline-set-interval-time] - '("Set interval time." . gnus-offline-set-interval-time)) - - (global-set-key - [menu-bar - offline - gnus-offline-hup-separator] - '("--")) - - (global-set-key - [menu-bar - offline - gnus-offline-set-unplugged-state] - '("Hang Up Line." . gnus-offline-set-unplugged-state))) + (easy-menu-define + gnus-offline-menu-on-agent + gnus-group-mode-map + "Gnus offline Menu" + (if (featurep 'meadow) + '("Offline" + ["movemail の切替え" gnus-offline-toggle-movemail-program + (not (locate-library "mail-source"))] + ["取得記事種類の変更" gnus-offline-toggle-articles-to-fetch t] + ["Mail 送信方法(On/Off)の切替え" gnus-offline-toggle-on/off-send-mail t] + ["自動切断の切替え" gnus-offline-toggle-auto-hangup t] + "----" + ["取得済記事を消す" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)] + ["記事取得間隔時間の設定" gnus-offline-set-interval-time t] + "----" + ["回線の切断" gnus-offline-set-unplugged-state gnus-offline-connected]) + '("Offline" + ["Toggle movemail program" gnus-offline-toggle-movemail-program + (not (locate-library "mail-source"))] + ["Toggle articles to fetch" gnus-offline-toggle-articles-to-fetch t] + ["Toggle online/offline send mail" gnus-offline-toggle-on/off-send-mail t] + ["Toggle auto hangup" gnus-offline-toggle-auto-hangup t] + "----" + ["Expire articles" gnus-offline-agent-expire (eq gnus-offline-news-fetch-method 'nnagent)] + ["Set interval time" gnus-offline-set-interval-time t] + "----" + ["Hang up Line." gnus-offline-set-unplugged-state gnus-offline-connected]))) + (and (featurep 'xemacs) + (easy-menu-add gnus-offline-menu-on-agent))) +;; +;; Popup menu within the group buffer (under Emacs). +;; +(defun gnus-offline-popup-menu (event) + "Popup menu for Gnus offline." + (interactive "e") + (let* ((menu (if (boundp 'miee-popup-menu) + (or (assoc 'keymap + (assoc 'Miee (assoc 'menu-bar global-map))) + miee-popup-menu) + gnus-offline-menu-on-agent)) + (pop (x-popup-menu t menu)) + (func (and pop (lookup-key menu (apply 'vector pop))))) + (and pop func (funcall func)))) ;; ;; Timer Function