cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/im+.el

   1 ;;;
   2 ;;; IM+
   3 ;;;
   4 ;;; Created  : Jan. 11, 1998
   5 ;;; Version  : 1.0
   6 ;;; Author   : ASAMI Tomoharu (tasami@ibm.net)
   7 ;;; HomePage : http://www.netpassport.or.jp/~wtasami
   8 ;;;
   9 ;
  10 ; [Minimum Setup]
  11 ;
  12 ; (autoload 'im+-show-imput-queue-status "im+" nil t)
  13 ; (autoload 'im+-show-imput-queue "im+" nil t)
  14 ; (autoload 'im+-xfer "im+" nil t)
  15 ;
  16 ; or
  17 ;
  18 ; (require 'im+)
  19 ;
  20 ; If you want to display the imput queue status on the status line from
  21 ; the startup, you should use the latter setting, or "require".
  22 ;
  23 ; [Using in Mew]
  24 ;
  25 ; (add-hook 'mew-init-hook
  26 ;         (function
  27 ;          (lambda ()
  28 ;            (define-key mew-summary-mode-map "b" (make-sparse-keymap))
  29 ;            (define-key mew-summary-mode-map "bs" 'im+-show-imput-queue-status)
  30 ;            (define-key mew-summary-mode-map "bq" 'im+-show-imput-queue)
  31 ;            (define-key mew-summary-mode-map "bx" 'im+-xfer))))
  32 ;
  33
  34 ;
  35 ; hooks
  36 ;
  37
  38 (defvar im+-before-xfer-hook nil
  39   "*Hook called before message transfer.")
  40 (defvar im+-after-xfer-hook nil
  41   "*Hook called after message transfer.")
  42
  43 ;
  44 ; configuration
  45 ;
  46
  47 (defvar im+-imput "imput"
  48   "*Full path name of the imput command")
  49 (defvar im+-imput-show-queue (concat im+-imput " -bp")
  50   "*Command with arguments to show the message queue")
  51 (defvar im+-imput-xfer (concat im+-imput " -q")
  52   "*Command with arguments to send messages")
  53 (defvar im+-pop-xfer nil
  54   "*Command with arguments to receive messages")
  55 (defvar im+-status-line t
  56   "*If non-nil, show imput queue status on status line")
  57 (defvar im+-get-number-of-queuing-mails-function
  58   (function im+-get-number-of-queuing-mails-by-file)
  59   "*Function to get number of queuing mails")
  60 (defvar im+-get-queuing-dir "~/.im/queue/"
  61   "*Imput queue directory")
  62 (defvar im+-imget-bp-regex "Message queued in"
  63   "*Regular expression to get number of queuing mails by imput with bp option")
  64
  65 ;
  66 ; public interfaces
  67 ;
  68
  69 (defun im+-show-imput-queue-status ()
  70   (interactive)
  71   (let (num)
  72     (setq num (im+-get-number-of-queuing-mails))
  73     (cond ((eq num 0)
  74            (message "Imput queue is empty."))
  75           ((eq num 1)
  76            (message "Imput queue has 1 message to send."))
  77           (t
  78            (message (format "Imput queue has %s messages to send." num))))))
  79
  80 (defun im+-show-imput-queue ()
  81   (interactive)
  82   (im+-show-from-command-line "*imput queue*" im+-imput-show-queue))
  83
  84 (defun im+-xfer ()
  85   (interactive)
  86   (cond (im+-before-xfer-hook
  87          (message "Prepare transfer...")
  88          (run-hooks 'im+-before-xfer-hook)))
  89   (message "Send messages...")
  90   (im+-get-string-from-command-line im+-imput-xfer)
  91   (cond (im+-pop-xfer
  92          (message "Receive messages...")
  93          (im+-get-string-from-command-line im+-pop-xfer)))
  94   (cond (im+-after-xfer-hook
  95          (message "Cleanup...")
  96          (run-hooks 'im+-after-xfer-hook)))
  97   (message "Done."))
  98
  99 ;
 100 ; subroutines
 101 ;
 102
 103 (defun im+-get-string-from-command-line (command-line)
 104   (apply (function im+-get-string-from-command)
 105          (im+-make-list-from-string command-line)))
 106
 107 (defun im+-get-string-from-command (command &rest arg)
 108   (let (buffer command-line string)
 109     (setq buffer (get-buffer-create "???im+-command???"))
 110     (save-excursion
 111       (set-buffer buffer)
 112       (erase-buffer)
 113       (setq command-line (append (list command nil buffer nil) arg))
 114       (apply 'call-process command-line)
 115       (goto-char (point-min))
 116       (setq string (buffer-string)))
 117     (kill-buffer buffer)
 118     string))
 119
 120 (defun im+-make-list-from-string (string &optional pattern)
 121   (let (buffer list)
 122     (if (null pattern)
 123         (setq pattern "[^ \t\n\f]+"))
 124     (setq buffer (get-buffer-create "???im+-temp???"))
 125     (save-excursion
 126       (set-buffer buffer)
 127       (erase-buffer)
 128       (insert string)
 129       (goto-char (point-min))
 130       (while (re-search-forward pattern nil t)
 131         (setq list (cons
 132                     (buffer-substring (match-beginning 0) (match-end 0))
 133                     list))))
 134     (kill-buffer buffer)
 135     (nreverse list)))
 136
 137 (defun im+-show-from-command-line (name command-line)
 138   (apply (function im+-show-from-command)
 139          (cons name (im+-make-list-from-string command-line))))
 140
 141 (defun im+-get-number-of-queuing-mails ()
 142   (apply im+-get-number-of-queuing-mails-function nil))
 143
 144 (defun im+-get-number-of-queuing-mails-by-file ()
 145   (let ((flag t)
 146         (num 1))
 147     (while flag
 148       (and (setq flag (file-exists-p (concat im+-get-queuing-dir num)))
 149            (setq num (+ num 1))))
 150     (- num 1)))
 151
 152 (defun im+-get-number-of-queuing-mails-by-imput ()
 153   (let (string)
 154     (setq string (im+-get-string-from-command-line im+-imput-show-queue))
 155     (setq string (im+-make-list-from-string string "Message queued in"))
 156     (length string)))
 157
 158 ; im+-show mode
 159
 160 (defun im+-show-from-command (name command &rest arg)
 161   (let (buffer command-line)
 162     (setq buffer (get-buffer-create name))
 163     (switch-to-buffer buffer)
 164     (erase-buffer)
 165     (setq major-mode 'im+-show-mode)
 166     (setq mode-name "Im+-Show")
 167     (use-local-map im+-show-mode-map)
 168     (setq buffer-read-only nil)
 169     (setq command-line (append (list command nil buffer nil) arg))
 170     (apply (function call-process) command-line)
 171     (setq buffer-read-only t)
 172     (set-buffer-modified-p nil)
 173     (goto-char 0)
 174     (message "q)uit  x)fer  u)pdate")))
 175
 176 (setq im+-show-mode-map (make-sparse-keymap))
 177 (define-key im+-show-mode-map "q" 'im+-show-quit)
 178 (define-key im+-show-mode-map "x" 'im+-show-xfer)
 179 (define-key im+-show-mode-map "u" 'im+-show-update)
 180
 181 (defun im+-show-quit ()
 182   (interactive)
 183   (kill-buffer (current-buffer)))
 184
 185 (defun im+-show-xfer ()
 186   (interactive)
 187   (im+-xfer)
 188   (kill-buffer (current-buffer))
 189   (im+-show-imput-queue))
 190
 191 (defun im+-show-update ()
 192   (interactive)
 193   (kill-buffer (current-buffer))
 194   (im+-show-imput-queue))
 195
 196 ; status line
 197
 198 (defun im+-imput-queue-status-line ()
 199   (let (num)
 200     (setq num (im+-get-number-of-queuing-mails))
 201     (cond ((> num 0)
 202            (format " MailQ[%s]" num))
 203           (t
 204            ""))))
 205
 206 (cond (im+-status-line
 207        (add-hook 'display-time-hook
 208                  (function
 209                   (lambda ()
 210                     (setq display-time-string
 211                           (concat display-time-string
 212                                   (im+-imput-queue-status-line))))))))
 213
 214 ;
 215
 216 (provide 'im+)