1 ;;; vm-biff.el --- a xlbiff like tool for VM
3 ;; Copyright (C) 2001 Robert Fenk
6 ;; Status: Tested with XEmacs 21.4.15 & VM 7.18
7 ;; Keywords: VM helpers
8 ;; X-URL: http://www.robf.de/Hacking/elisp
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2 of the License, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License along
21 ;; with this program; if not, write to the Free Software Foundation, Inc.,
22 ;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
26 ;; Put this file into your load path and add the following line to your .vm
31 ;; Try: M-x customize-group vm-biff RET
33 ;; You should set `vm-auto-get-newmail', since otherwise this package
34 ;; does not make any sense! If getting mail is slow, use fetchmail to
35 ;; retrieve it to a local file and uses that file as VM spool file!
53 (defcustom vm-biff-position 'center
54 "*Position of the popup-frame."
56 :type '(choice (const :tag "center the popup frame" center)
57 (list :tag "Position of the top-left corner."
63 (defcustom vm-biff-width 120
64 "*Width of the popup-frame."
68 (defcustom vm-biff-max-height 10
69 "*Maximum hight of the popup window."
73 (defcustom vm-biff-body-peek 50
74 "*Maximum number of chractes to peek into the body of a message."
79 (defcustom vm-biff-focus-popup nil
80 "*t if popup window should get the focus after an update."
84 (defcustom vm-biff-auto-remove nil
85 "*Number of seconds after the popup window is automatically removed."
87 :type '(choice (integer :tag "Number of seconds" 10)
88 (const :tag "Disable remove" nil)))
90 (defcustom vm-biff-summary-format nil
91 "*Like `vm-summary-format' but for popup buffers."
93 :type '(choice (string :tag "Summary format")
94 (const :tag "Disable own format" nil)))
96 (defcustom vm-biff-selector '(and (new)
99 "*virtual folder selector matching messages to display in the pop-up."
103 (defcustom vm-biff-place-frame-function 'vm-biff-place-frame
104 "*Function that sets the popup frame position and size."
108 (defcustom vm-biff-select-hook nil
109 "*List of hook functions to be run when selection a message."
111 :type '(repeat (function)))
113 (defcustom vm-biff-select-frame-hook nil
114 "*List of hook functions to be run when selection a message.
115 You may want to add `vm-biff-fvwm-focus-vm-folder-frame'.
118 :type '(repeat (function)))
120 (defcustom vm-biff-folder-list nil
121 "*List of folders to generate a popup for.
122 The default is all spool files listed in `vm-spool-files'.
123 Testing is done by string-matching it against the current buffer-file-name.
125 Another form is an alist of elements (FODERNAME SELECTOR),
126 where SELECTOR is a virtual folder selector matching the
127 messges which should be displayed. See `vm-biff-selector'
128 for an example and `vm-virtual-folder-alist' on how virtual
129 folder selectors work."
131 :type '(repeat (string)))
133 (defvar vm-biff-keymap nil
134 "Keymap for vm-biff popup buffers.")
136 (when (not vm-biff-keymap)
137 (setq vm-biff-keymap (make-sparse-keymap "VM Biff"))
138 (define-key vm-biff-keymap "q" 'vm-biff-delete-popup)
139 (define-key vm-biff-keymap " " 'vm-biff-delete-popup)
140 (define-key vm-biff-keymap [(space)] 'vm-biff-delete-popup)
141 (define-key vm-biff-keymap [(button1)] 'vm-biff-delete-popup)
142 (define-key vm-biff-keymap [(mouse-1)] 'vm-biff-delete-popup)
143 (define-key vm-biff-keymap [(return)] 'vm-biff-select-message)
144 (define-key vm-biff-keymap [(button2)] 'vm-biff-select-message-mouse)
145 (define-key vm-biff-keymap [(mouse-2)] 'vm-biff-select-message-mouse))
147 (defun vm-summary-function-V (msg)
148 (let ((body-start (vm-text-of msg))
149 (body-end (vm-end-of msg))
151 (if (< vm-biff-body-peek (- body-end body-start))
152 (setq body-end (+ vm-biff-body-peek body-start)))
155 (set-buffer (vm-buffer-of msg))
158 (re-search-forward "$" (point-max) t)
159 (setq peek (vm-decode-mime-encoded-words-in-string
160 (buffer-substring body-start (point))))
162 (if (string-match "^\n+" peek pos)
163 (setq peek (replace-match "" t t peek)))
164 (while (setq pos (string-match "\n\n+" peek pos))
165 (setq peek (replace-match "\n" t t peek)))
167 (while (setq pos (string-match "\n" peek pos))
168 (setq peek (replace-match "\n\t" t t peek)
170 (setq peek (concat "\t" peek))
171 (put-text-property 0 (length peek) 'face 'bold peek)
174 (defun vm-biff-place-frame (&optional f)
175 "Centers the frame and limits it to `vm-biff-max-height' lines."
176 (let ((f (or f (selected-frame)))
177 (height (1+ (count-lines (point-min) (point-max)))))
178 (if (> height vm-biff-max-height)
179 (setq height vm-biff-max-height))
180 (set-frame-size f vm-biff-width height)
182 (if (eq 'center vm-biff-position)
185 (/ (- (x-display-pixel-width) (frame-pixel-width f)) 2)
186 (/ (- (x-display-pixel-height) (frame-pixel-height f)) 2))
187 (apply 'set-frame-position f vm-biff-position))))
189 (defconst vm-biff-frame-properties
190 '(;; common properties
195 (menubar-visible-p . nil)
196 (default-toolbar-visible-p . nil)
197 ; (has-modeline-p . nil)
201 (initially-unmapped . t)
202 (modeline-shadow-thickness . 0)
203 (vertical-scrollbar . nil)
204 ;; GNU Emacs properties
205 (vertical-scroll-bars . nil)
210 "Default properties for popup frame.")
212 (defvar vm-biff-message-pointer nil)
213 (defvar vm-biff-folder-buffer nil)
214 (defvar vm-biff-message-number nil)
215 (defvar vm-biff-folder-frame nil)
216 (defvar vm-biff--folder-window nil)
218 (defun vm-biff-x-p ()
220 (memq (console-type) '(x mswindows))
223 (defun vm-biff-get-buffer-window (buf)
225 (get-buffer-window buf (vm-biff-x-p) (frame-device))
226 (get-buffer-window buf (vm-biff-x-p))))
228 (defun vm-biff-find-folder-window (msg)
229 (let ((buf (vm-buffer-of msg)))
232 (or (vm-biff-get-buffer-window buf)
233 (and vm-presentation-buffer
234 (vm-biff-get-buffer-window vm-presentation-buffer))
235 (and vm-summary-buffer
236 (vm-biff-get-buffer-window vm-summary-buffer))))))
238 (defun vm-biff-find-folder-frame (msg)
239 (let ((ff (vm-biff-find-folder-window msg)))
240 (if ff (window-frame ff))))
243 (defun vm-biff-select-message ()
244 "Put focus on the folder frame and select the appropiate message."
246 (let* ((vm-biff-message-pointer
247 (or (get-text-property (point) 'vm-message-pointer)
248 vm-biff-message-pointer))
249 (msg (car vm-biff-message-pointer))
250 (vm-biff-message-number (vm-number-of msg))
251 (vm-biff-folder-buffer (vm-buffer-of msg))
252 (vm-biff-folder-window (vm-biff-find-folder-window msg))
253 vm-biff-folder-frame)
255 (if vm-biff-folder-window
256 (setq vm-biff-folder-frame (window-frame vm-biff-folder-window)))
258 (setq vm-biff-message-pointer nil)
259 (vm-biff-delete-popup)
261 (cond ((and vm-biff-folder-frame (vm-biff-x-p))
262 (select-frame vm-biff-folder-frame)
263 (focus-frame vm-biff-folder-frame)
264 (raise-frame vm-biff-folder-frame)
265 (run-hooks 'vm-biff-select-frame-hook)
266 (select-window vm-biff-folder-window))
267 (vm-biff-folder-window
268 (select-window vm-biff-folder-window))
271 (switch-to-buffer vm-biff-folder-buffer)))
275 (if vm-biff-message-number
276 (vm-goto-message (string-to-number (vm-number-of msg))))
278 (run-hooks 'vm-biff-select-hook)))
281 (defun vm-biff-select-message-mouse (event)
283 (mouse-set-point event)
284 (vm-biff-select-message))
286 (defcustom vm-biff-FvwmCommand-path "/usr/bin/FvwmCommand"
287 "Full qualified path to FvwmCommand."
292 (defun vm-biff-fvwm-focus-vm-folder-frame ()
293 "Jumps to the frame containing the folder for the selected message.
295 1) Your Emacs frame needs to have the folder name in its title, see the
296 variable `frame-title-format' on how to set this up.
298 2) You need to define the FVWM2 function SelectWindow and start the
299 FvwmCommandS module. Therefore, you will need the following lines
300 in your .fvwm2rc file.
302 AddToFunc InitFunction
303 + I Module FvwmCommandS
305 AddToFunc RestartFunction
306 + I Module FvwmCommandS
308 AddToFunc SelectWindow
309 + I Next ($0) Iconify false
311 + I Next ($0) WarpToWindow 10p 10p
314 (let ((p (start-process "FvwmCommand"
316 vm-biff-FvwmCommand-path
318 (process-send-string p (concat "SelectWindow *"
319 (buffer-name vm-biff-folder-buffer)
321 (process-send-eof p)))
324 (defun vm-biff-delete-popup (&optional wf)
328 (if (not (one-window-p))
332 (defun vm-biff-timer-delete-popup (wf)
333 (if (featurep 'itimer)
334 (delete-itimer current-itimer))
335 (vm-biff-delete-popup wf))
337 (defvar vm-biff-message-pointer nil)
338 (make-variable-buffer-local 'vm-biff-message-pointer)
341 (defun vm-biff-popup (&optional force)
342 "Scan the current VM folder for new messages and popup a summary frame."
343 (interactive (list current-prefix-arg))
346 (vm-select-folder-buffer)
348 (when (not vm-biff-folder-list)
349 (setq vm-biff-folder-list
350 (if (stringp (car vm-spool-files))
351 (list (expand-file-name
353 vm-folder-directory))
357 vm-folder-directory))
360 (let* ((mp vm-message-pointer)
361 (folder (buffer-name))
363 (and vm-mouse-track-summary
364 (vm-mouse-support-possible-p)))
365 (buf (get-buffer-create
366 (concat " *new messages in VM folder: " folder "*")))
367 selector msg new-messages wf)
369 (let ((fl vm-biff-folder-list))
371 (if (stringp (car fl))
372 (if (string-match (car fl) (or (buffer-file-name)
374 (setq selector (list vm-biff-selector) fl nil))
375 (if (string-match (caar fl) (or (buffer-file-name)
377 (setq selector (cdar fl) fl nil)))
381 ;; collect the new messages
383 (setq buffer-read-only nil)
389 (when (apply 'vm-vs-or msg selector)
391 (vm-tokenized-summary-insert msg
393 (or vm-biff-summary-format
396 (put-text-property start (point) 'vm-message-pointer mp)
398 (vm-summary-highlight-region start (point)
399 vm-summary-highlight-face)
402 (vm-mouse-set-mouse-track-highlight
405 (if (not new-messages) (setq new-messages mp)))
408 (when (and new-messages
410 (not (equal new-messages vm-biff-message-pointer))))
411 (setq msg (car new-messages))
412 (backward-delete-char 1)
413 (goto-char (point-min))
415 (setq truncate-lines t
417 (use-local-map vm-biff-keymap)
418 (setq vm-biff-message-pointer new-messages)
420 ;; if in the minibuffer then seletc a different window
421 (if (active-minibuffer-window)
424 ;; generate a own window/frame showing the messages
426 ;; X Window System or MS Windows
427 (let* ((sf (selected-frame))
428 (ff (vm-biff-find-folder-frame msg))
430 (cons (cons 'popup ff)
431 vm-biff-frame-properties)
432 vm-biff-frame-properties))
433 (mf (or (and (if vm-xemacs-p
434 (get-buffer-window buf t (frame-device))
435 (get-buffer-window buf t))
437 (vm-biff-get-buffer-window buf)))
438 (make-frame props))))
441 (switch-to-buffer buf)
443 (set-specifier horizontal-scrollbar-visible-p nil))
445 (if (functionp vm-biff-place-frame-function)
446 (funcall vm-biff-place-frame-function))
448 (make-frame-visible mf)
451 (if vm-biff-focus-popup (focus-frame mf)
455 (let ((w (vm-get-buffer-window buf))
456 (window-min-height 2)
457 (h (count-lines (point-min) (point-max))))
459 (if vm-biff-focus-popup (select-window w))
460 (setq wf (split-window (selected-window))))
462 (switch-to-buffer buf)
463 (if (> h vm-biff-max-height)
464 (setq h vm-biff-max-height))
465 (setq h (- (window-displayed-height) h))
466 (if (not (one-window-p))
467 (shrink-window h)))))
469 (if vm-biff-auto-remove
472 (progn (require 'itimer) t)
474 (start-itimer (buffer-name)
475 'vm-biff-timer-delete-popup
479 (progn (require 'timer) t)
481 (run-at-time vm-biff-auto-remove nil
482 'vm-biff-timer-delete-popup wf))))))))
484 (add-hook 'vm-arrived-messages-hook 'vm-biff-popup t)