home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / vm / vm-5.33beta / vm-virtual.el < prev    next >
Encoding:
Text File  |  1991-04-10  |  5.4 KB  |  175 lines
  1. ;;; Virtual folders
  2. ;;; Copyright (C) 1990 Kyle E. Jones
  3. ;;;
  4. ;;; This program is free software; you can redistribute it and/or modify
  5. ;;; it under the terms of the GNU General Public License as published by
  6. ;;; the Free Software Foundation; either version 1, or (at your option)
  7. ;;; any later version.
  8. ;;;
  9. ;;; This program is distributed in the hope that it will be useful,
  10. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. ;;; GNU General Public License for more details.
  13. ;;;
  14. ;;; You should have received a copy of the GNU General Public License
  15. ;;; along with this program; if not, write to the Free Software
  16. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18. (defun vm-visit-virtual-folder (folder-name &optional read-only)
  19.   (interactive
  20.    (progn
  21.      (vm-session-initialization)
  22.      (list
  23.       (completing-read "Visit virtual folder: " vm-virtual-folder-alist nil t)
  24.       current-prefix-arg)))
  25.   (vm-session-initialization)
  26.   (if (not (assoc folder-name vm-virtual-folder-alist))
  27.       (error "No such virtual folder, %s" folder-name))
  28.   (let ((buffer-name (concat folder-name " virtual"))
  29.     first-time)
  30.     (set-buffer (get-buffer-create buffer-name))
  31.     (setq first-time (not (eq major-mode 'vm-virtual-mode)))
  32.     (if first-time
  33.     (progn
  34.       (setq major-mode 'vm-virtual-mode
  35.         mode-name "VM Virtual"
  36.         mode-line-format vm-mode-line-format
  37.         buffer-read-only t
  38.         vm-folder-read-only read-only
  39.         truncate-lines t
  40.         vm-current-grouping vm-group-by
  41.         vm-mail-buffer (current-buffer)
  42.         vm-summary-buffer vm-mail-buffer
  43.         vm-numbering-redo-start-point t
  44.         vm-summary-redo-start-point t)
  45.       (buffer-flush-undo (current-buffer))
  46.       (abbrev-mode 0)
  47.       (auto-fill-mode 0)
  48.       (vm-build-virtual-message-list
  49.        (assoc folder-name vm-virtual-folder-alist)
  50.        read-only)
  51.       (vm-thoughtfully-select-message)
  52.       (use-local-map vm-mode-map)
  53.       (vm-emit-totals-blurb)))
  54.     (switch-to-buffer (current-buffer))
  55.     (and (not vm-inhibit-startup-message) (not vm-startup-message-displayed)
  56.      (vm-display-startup-message))))
  57.  
  58. (defun vm-build-virtual-message-list (def read-only)
  59.   (let ((clauses (cdr def))
  60.     ;; letter bomb protection
  61.     (inhibit-local-variables t)
  62.     (vbuffer (current-buffer))
  63.     (inhibit-quit t)
  64.     message-list folders folder selector-list selector arg
  65.     buffers-used)
  66.     (save-excursion
  67.       (while clauses
  68.     (setq folders (car (car clauses))
  69.           selector-list (cdr (car clauses)))
  70.     (while selector-list
  71.       (setq selector
  72.         (intern
  73.          (concat "vm-vs-" (symbol-name (car (car selector-list))))))
  74.       (if (cdr (car selector-list))
  75.           (setq arg (car (cdr (car selector-list))))
  76.         (setq arg nil))
  77.       (while folders
  78.         (setq folder (car folders))
  79.         (while
  80.         (not
  81.          (equal folder
  82.             (setq folder
  83.                   (expand-file-name folder vm-folder-directory)))))
  84.         (if (file-directory-p folder)
  85.         (setq folders (nconc (cdr folders)
  86.                      (vm-delete-directories
  87.                       (directory-files folder t nil))))
  88.           (set-buffer (or (get-file-buffer folder)
  89.                   (find-file-noselect folder)))
  90.           (if (not (memq vbuffer vm-virtual-buffers))
  91.           (setq vm-virtual-buffers (cons vbuffer vm-virtual-buffers)
  92.             buffers-used (cons (current-buffer) buffers-used)))
  93.           (if (not (eq major-mode 'vm-mode))
  94.           (vm-mode))
  95.           (setq mp vm-message-list)
  96.           (while mp
  97.         (if (if arg
  98.             (funcall selector (car mp) arg)
  99.               (funcall selector (car mp)))
  100.             (progn
  101.               (setq message-list (cons (copy-sequence (car mp))
  102.                            message-list))
  103.               (if vm-virtual-mirror
  104.               (vm-set-virtual-messages-of
  105.                (car mp)
  106.                (cons (car message-list)
  107.                  (vm-virtual-messages-of (car mp))))
  108.             (vm-set-attributes-of
  109.              (car message-list)
  110.              (make-vector vm-attributes-vector-length nil)))
  111.               (vm-set-softdata-of
  112.                (car message-list)
  113.                (copy-sequence (vm-softdata-of
  114.                        (car message-list))))
  115.               (vm-set-mark-of (car message-list) nil)))
  116.         (setq mp (cdr mp)))
  117.           (setq folders (cdr folders))))
  118.       (setq selector-list (cdr selector-list)))
  119.     (setq clauses (cdr clauses))))
  120.     (setq vm-message-list (nreverse message-list)
  121.       vm-real-buffers buffers-used)))
  122.  
  123. (defun vm-delete-directories (list)
  124.   (vm-delete 'file-directory-p list))
  125.  
  126. (defun vm-vs-any (m) t)
  127.  
  128. (defun vm-vs-author (m arg)
  129.   (or (string-match arg (vm-su-full-name m))
  130.       (string-match arg (vm-su-from m))))
  131.  
  132. (defun vm-vs-recipient (m arg)
  133.   (or (string-match arg (vm-su-to m))
  134.       (string-match arg (vm-su-to-names m))))
  135.  
  136. (defun vm-vs-subject (m arg)
  137.   (string-match arg (vm-su-subject m)))
  138.  
  139. (defun vm-vs-header (m arg)
  140.   (save-excursion
  141.     (save-restriction
  142.       (widen)
  143.       (goto-char (vm-start-of m))
  144.       (forward-line)
  145.       (re-search-forward arg (vm-text-of m) t))))
  146.  
  147. (defun vm-vs-text (m arg)
  148.   (save-excursion
  149.     (save-restriction
  150.       (widen)
  151.       (goto-char (vm-text-of m))
  152.       (re-search-forward arg (vm-text-end-of m) t))))
  153.  
  154. (defun vm-virtual-quit ()
  155.   (if (and (eq vm-confirm-quit t)
  156.        (not (y-or-n-p "Do you really want to quit? ")))
  157.       (error "Aborted")
  158.     (message ""))
  159.   (let ((bp vm-real-buffers)
  160.     (mp vm-message-list)
  161.     (b (current-buffer))
  162.     (inhibit-quit t))
  163.     (save-excursion
  164.       (while bp
  165.     (set-buffer (car bp))
  166.     (setq vm-virtual-buffers (delq b vm-virtual-buffers)
  167.           bp (cdr bp))))
  168.     (while mp
  169.       (vm-set-virtual-messages-of
  170.        (car mp)
  171.        (delq (car mp) (vm-virtual-messages-of (car mp))))
  172.       (setq mp (cdr mp)))
  173.     (set-buffer-modified-p nil)
  174.     (kill-buffer (current-buffer))))
  175.