Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-folder.el @ 102:a145efe76779 r20-1b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 4be1180a9e89
children 360340f9fd5f
comparison
equal deleted inserted replaced
101:a0ec055d74dd 102:a145efe76779
917 tail-cons vm-message-list) 917 tail-cons vm-message-list)
918 (setcdr tail-cons (list message)) 918 (setcdr tail-cons (list message))
919 (setq tail-cons (cdr tail-cons))) 919 (setq tail-cons (cdr tail-cons)))
920 (vm-increment n) 920 (vm-increment n)
921 (if (zerop (% n modulus)) 921 (if (zerop (% n modulus))
922 (vm-unsaved-message "Parsing messages... %d" n))) 922 (message "Parsing messages... %d" n)))
923 (if (>= n modulus) 923 (if (>= n modulus)
924 (vm-unsaved-message "Parsing messages... done")) 924 (message "Parsing messages... done"))
925 (if (and (not (= last-end (point-max))) 925 (if (and (not (= last-end (point-max)))
926 (not (eq vm-folder-type 'unknown))) 926 (not (eq vm-folder-type 'unknown)))
927 (progn 927 (progn
928 (message "Warning: garbage found at end of folder, %s" 928 (message "Warning: garbage found at end of folder, %s"
929 (or buffer-file-name (buffer-name))) 929 (or buffer-file-name (buffer-name)))
1253 ((vm-new-flag (car mp)) 1253 ((vm-new-flag (car mp))
1254 (vm-increment vm-new-count)) 1254 (vm-increment vm-new-count))
1255 ((vm-unread-flag (car mp)) 1255 ((vm-unread-flag (car mp))
1256 (vm-increment vm-unread-count))) 1256 (vm-increment vm-unread-count)))
1257 (if (zerop (% vm-total-count modulus)) 1257 (if (zerop (% vm-total-count modulus))
1258 (vm-unsaved-message "Reading attributes... %d" vm-total-count)) 1258 (message "Reading attributes... %d" vm-total-count))
1259 (setq mp (cdr mp))) 1259 (setq mp (cdr mp)))
1260 (if (>= vm-total-count modulus) 1260 (if (>= vm-total-count modulus)
1261 (vm-unsaved-message "Reading attributes... done")) 1261 (message "Reading attributes... done"))
1262 (if (null message-list) 1262 (if (null message-list)
1263 (setq vm-totals (list vm-modification-counter 1263 (setq vm-totals (list vm-modification-counter
1264 vm-total-count 1264 vm-total-count
1265 vm-new-count 1265 vm-new-count
1266 vm-unread-count 1266 vm-unread-count
1455 ;; folder was saved, then we have to discard any cached 1455 ;; folder was saved, then we have to discard any cached
1456 ;; vheader info so the user will see the right headers. 1456 ;; vheader info so the user will see the right headers.
1457 (and got (or (not (equal vis vm-visible-headers)) 1457 (and got (or (not (equal vis vm-visible-headers))
1458 (not (equal invis vm-invisible-header-regexp))) 1458 (not (equal invis vm-invisible-header-regexp)))
1459 (let ((mp vm-message-list)) 1459 (let ((mp vm-message-list))
1460 (vm-unsaved-message "Discarding visible header info...") 1460 (message "Discarding visible header info...")
1461 (while mp 1461 (while mp
1462 (vm-set-vheaders-regexp-of (car mp) nil) 1462 (vm-set-vheaders-regexp-of (car mp) nil)
1463 (vm-set-vheaders-of (car mp) nil) 1463 (vm-set-vheaders-of (car mp) nil)
1464 (setq mp (cdr mp))))))))))) 1464 (setq mp (cdr mp)))))))))))
1465 1465
1481 (goto-char (point-min)) 1481 (goto-char (point-min))
1482 (vm-skip-past-folder-header) 1482 (vm-skip-past-folder-header)
1483 (vm-skip-past-leading-message-separator) 1483 (vm-skip-past-leading-message-separator)
1484 (if (re-search-forward vm-message-order-header-regexp lim t) 1484 (if (re-search-forward vm-message-order-header-regexp lim t)
1485 (progn 1485 (progn
1486 (vm-unsaved-message "Reordering messages...") 1486 (message "Reordering messages...")
1487 (setq order (read (current-buffer)) 1487 (setq order (read (current-buffer))
1488 list-length (length vm-message-list) 1488 list-length (length vm-message-list)
1489 v (make-vector (max list-length (length order)) nil)) 1489 v (make-vector (max list-length (length order)) nil))
1490 (while (and order mp) 1490 (while (and order mp)
1491 (aset v (1- (car order)) (car mp)) 1491 (aset v (1- (car order)) (car mp))
1498 vm-message-order-header-present t 1498 vm-message-order-header-present t
1499 vm-message-pointer (memq (car vm-message-pointer) 1499 vm-message-pointer (memq (car vm-message-pointer)
1500 vm-message-list)) 1500 vm-message-list))
1501 (vm-set-numbering-redo-start-point t) 1501 (vm-set-numbering-redo-start-point t)
1502 (vm-reverse-link-messages)) 1502 (vm-reverse-link-messages))
1503 (vm-unsaved-message "Reordering messages... done"))))))) 1503 (message "Reordering messages... done")))))))
1504 1504
1505 ;; Read the header that gives the folder's cached summary format 1505 ;; Read the header that gives the folder's cached summary format
1506 ;; If the current summary format is different, then the cached 1506 ;; If the current summary format is different, then the cached
1507 ;; summary lines are discarded. 1507 ;; summary lines are discarded.
1508 (defun vm-gobble-summary () 1508 (defun vm-gobble-summary ()
2112 2112
2113 (vm-virtual-quit) 2113 (vm-virtual-quit)
2114 (if (and (not no-change) (not virtual)) 2114 (if (and (not no-change) (not virtual))
2115 (progn 2115 (progn
2116 ;; this could take a while, so give the user some feedback 2116 ;; this could take a while, so give the user some feedback
2117 (vm-unsaved-message "Quitting...") 2117 (message "Quitting...")
2118 (or vm-folder-read-only (eq major-mode 'vm-virtual-mode) 2118 (or vm-folder-read-only (eq major-mode 'vm-virtual-mode)
2119 (vm-change-all-new-to-unread)))) 2119 (vm-change-all-new-to-unread))))
2120 (if (and (buffer-modified-p) 2120 (if (and (buffer-modified-p)
2121 (or buffer-file-name buffer-offer-save) 2121 (or buffer-file-name buffer-offer-save)
2122 (not no-change) 2122 (not no-change)
2123 (not virtual)) 2123 (not virtual))
2124 (vm-save-folder)) 2124 (vm-save-folder))
2125 (vm-unsaved-message "") 2125 (message "")
2126 (let ((summary-buffer vm-summary-buffer) 2126 (let ((summary-buffer vm-summary-buffer)
2127 (pres-buffer vm-presentation-buffer-handle) 2127 (pres-buffer vm-presentation-buffer-handle)
2128 (mail-buffer (current-buffer))) 2128 (mail-buffer (current-buffer)))
2129 (if summary-buffer 2129 (if summary-buffer
2130 (progn 2130 (progn
2193 ;; interrupt the check. Bogus. 2193 ;; interrupt the check. Bogus.
2194 (setq inhibit-quit nil) 2194 (setq inhibit-quit nil)
2195 (if (integerp vm-mail-check-interval) 2195 (if (integerp vm-mail-check-interval)
2196 (if timer 2196 (if timer
2197 (timer-set-time timer (current-time) vm-mail-check-interval) 2197 (timer-set-time timer (current-time) vm-mail-check-interval)
2198 (set-itimer-restart current-itimer vm-mail-check-interval))) 2198 (set-itimer-restart current-itimer vm-mail-check-interval))
2199 ;; user has changed the variable value to a something that
2200 ;; isn't a number, make the timer go away.
2201 (if timer
2202 (cancel-timer timer)
2203 (set-itimer-restart current-itimer nil)))
2199 (let ((b-list (buffer-list)) 2204 (let ((b-list (buffer-list))
2205 (found-one nil)
2200 oldval) 2206 oldval)
2201 (while (and (not (input-pending-p)) b-list) 2207 (while (and (not (input-pending-p)) b-list)
2202 (save-excursion 2208 (save-excursion
2203 (set-buffer (car b-list)) 2209 (set-buffer (car b-list))
2204 (if (and (eq major-mode 'vm-mode) 2210 (if (and (eq major-mode 'vm-mode)
2211 (setq found-one t)
2205 (not vm-block-new-mail)) 2212 (not vm-block-new-mail))
2206 (progn 2213 (progn
2207 (setq oldval vm-spooled-mail-waiting) 2214 (setq oldval vm-spooled-mail-waiting)
2208 (vm-check-for-spooled-mail nil) 2215 (vm-check-for-spooled-mail nil)
2209 (if (not (eq oldval vm-spooled-mail-waiting)) 2216 (if (not (eq oldval vm-spooled-mail-waiting))
2210 (progn 2217 (progn
2211 (intern (buffer-name) vm-buffers-needing-display-update) 2218 (intern (buffer-name) vm-buffers-needing-display-update)
2212 (vm-update-summary-and-mode-line)))))) 2219 (vm-update-summary-and-mode-line))))))
2213 (setq b-list (cdr b-list))))) 2220 (setq b-list (cdr b-list)))
2221 ;; make the timer go away if we didn't encounter a vm-mode buffer.
2222 (if (and (not found-one) (null b-list))
2223 (if timer
2224 (cancel-timer timer)
2225 (set-itimer-restart current-itimer nil)))))
2214 2226
2215 ;; support for numeric vm-auto-get-new-mail 2227 ;; support for numeric vm-auto-get-new-mail
2216 ;; if timer argument is present, this means we're using the Emacs 2228 ;; if timer argument is present, this means we're using the Emacs
2217 ;; 'timer package rather than the 'itimer package. 2229 ;; 'timer package rather than the 'itimer package.
2218 (defun vm-get-mail-itimer-function (&optional timer) 2230 (defun vm-get-mail-itimer-function (&optional timer)
2220 ;; interrupt mail retrieval. Bogus. 2232 ;; interrupt mail retrieval. Bogus.
2221 (setq inhibit-quit nil) 2233 (setq inhibit-quit nil)
2222 (if (integerp vm-auto-get-new-mail) 2234 (if (integerp vm-auto-get-new-mail)
2223 (if timer 2235 (if timer
2224 (timer-set-time timer (current-time) vm-auto-get-new-mail) 2236 (timer-set-time timer (current-time) vm-auto-get-new-mail)
2225 (set-itimer-restart current-itimer vm-auto-get-new-mail))) 2237 (set-itimer-restart current-itimer vm-auto-get-new-mail))
2226 (let ((b-list (buffer-list))) 2238 ;; user has changed the variable value to a something that
2239 ;; isn't a number, make the timer go away.
2240 (if timer
2241 (cancel-timer timer)
2242 (set-itimer-restart current-itimer nil)))
2243 (let ((b-list (buffer-list))
2244 (found-one nil))
2227 (while (and (not (input-pending-p)) b-list) 2245 (while (and (not (input-pending-p)) b-list)
2228 (save-excursion 2246 (save-excursion
2229 (set-buffer (car b-list)) 2247 (set-buffer (car b-list))
2230 (if (and (eq major-mode 'vm-mode) 2248 (if (and (eq major-mode 'vm-mode)
2249 (setq found-one t)
2231 (not (and (not (buffer-modified-p)) 2250 (not (and (not (buffer-modified-p))
2232 buffer-file-name 2251 buffer-file-name
2233 (file-newer-than-file-p 2252 (file-newer-than-file-p
2234 (make-auto-save-file-name) 2253 (make-auto-save-file-name)
2235 buffer-file-name))) 2254 buffer-file-name)))
2242 ;; was empty. 2261 ;; was empty.
2243 (if (and (null vm-message-pointer) 2262 (if (and (null vm-message-pointer)
2244 (vm-thoughtfully-select-message)) 2263 (vm-thoughtfully-select-message))
2245 (vm-preview-current-message) 2264 (vm-preview-current-message)
2246 (vm-update-summary-and-mode-line))))) 2265 (vm-update-summary-and-mode-line)))))
2247 (setq b-list (cdr b-list))))) 2266 (setq b-list (cdr b-list)))
2267 ;; make the timer go away if we didn't encounter a vm-mode buffer.
2268 (if (and (not found-one) (null b-list))
2269 (if timer
2270 (cancel-timer timer)
2271 (set-itimer-restart current-itimer nil)))))
2248 2272
2249 ;; support for numeric vm-flush-interval 2273 ;; support for numeric vm-flush-interval
2250 ;; if timer argument is present, this means we're using the Emacs 2274 ;; if timer argument is present, this means we're using the Emacs
2251 ;; 'timer package rather than the 'itimer package. 2275 ;; 'timer package rather than the 'itimer package.
2252 (defun vm-flush-itimer-function (&optional timer) 2276 (defun vm-flush-itimer-function (&optional timer)
2343 (if (eq major-mode 'vm-virtual-mode) 2367 (if (eq major-mode 'vm-virtual-mode)
2344 (vm-virtual-save-folder prefix) 2368 (vm-virtual-save-folder prefix)
2345 (if (buffer-modified-p) 2369 (if (buffer-modified-p)
2346 (let (mp (newlist nil)) 2370 (let (mp (newlist nil))
2347 ;; stuff the attributes of messages that need it. 2371 ;; stuff the attributes of messages that need it.
2348 (vm-unsaved-message "Stuffing attributes...") 2372 (message "Stuffing attributes...")
2349 (vm-stuff-folder-attributes nil) 2373 (vm-stuff-folder-attributes nil)
2350 ;; stuff bookmark and header variable values 2374 ;; stuff bookmark and header variable values
2351 (if vm-message-list 2375 (if vm-message-list
2352 (progn 2376 (progn
2353 ;; get summary cache up-to-date 2377 ;; get summary cache up-to-date
2356 (vm-stuff-header-variables) 2380 (vm-stuff-header-variables)
2357 (vm-stuff-labels) 2381 (vm-stuff-labels)
2358 (vm-stuff-summary) 2382 (vm-stuff-summary)
2359 (and vm-message-order-changed 2383 (and vm-message-order-changed
2360 (vm-stuff-message-order)))) 2384 (vm-stuff-message-order))))
2361 (vm-unsaved-message "Saving...") 2385 (message "Saving...")
2362 (let ((vm-inhibit-write-file-hook t)) 2386 (let ((vm-inhibit-write-file-hook t))
2363 (save-buffer prefix)) 2387 (save-buffer prefix))
2364 (vm-set-buffer-modified-p nil) 2388 (vm-set-buffer-modified-p nil)
2365 (vm-clear-modification-flag-undos) 2389 (vm-clear-modification-flag-undos)
2366 (setq vm-messages-not-on-disk 0) 2390 (setq vm-messages-not-on-disk 0)
2392 (vm-check-for-killed-summary) 2416 (vm-check-for-killed-summary)
2393 (vm-display nil nil '(vm-save-and-expunge-folder) 2417 (vm-display nil nil '(vm-save-and-expunge-folder)
2394 '(vm-save-and-expunge-folder)) 2418 '(vm-save-and-expunge-folder))
2395 (if (not vm-folder-read-only) 2419 (if (not vm-folder-read-only)
2396 (progn 2420 (progn
2397 (vm-unsaved-message "Expunging...") 2421 (message "Expunging...")
2398 (vm-expunge-folder t))) 2422 (vm-expunge-folder t)))
2399 (vm-save-folder prefix)) 2423 (vm-save-folder prefix))
2400 2424
2401 (defun vm-handle-file-recovery-or-reversion (recovery) 2425 (defun vm-handle-file-recovery-or-reversion (recovery)
2402 (if (and vm-summary-buffer (buffer-name vm-summary-buffer)) 2426 (if (and vm-summary-buffer (buffer-name vm-summary-buffer))
2780 (vm-virtual-get-new-mail)) 2804 (vm-virtual-get-new-mail))
2781 ((null arg) 2805 ((null arg)
2782 (if (not (eq major-mode 'vm-mode)) 2806 (if (not (eq major-mode 'vm-mode))
2783 (vm-mode)) 2807 (vm-mode))
2784 (if (consp (car (vm-spool-files))) 2808 (if (consp (car (vm-spool-files)))
2785 (vm-unsaved-message "Checking for new mail for %s..." 2809 (message "Checking for new mail for %s..."
2786 (or buffer-file-name (buffer-name))) 2810 (or buffer-file-name (buffer-name)))
2787 (vm-unsaved-message "Checking for new mail...")) 2811 (message "Checking for new mail..."))
2788 (let (totals-blurb) 2812 (let (totals-blurb)
2789 (if (and (vm-get-spooled-mail t) (vm-assimilate-new-messages t)) 2813 (if (and (vm-get-spooled-mail t) (vm-assimilate-new-messages t))
2790 (progn 2814 (progn
2791 ;; say this NOW, before the non-previewers read 2815 ;; say this NOW, before the non-previewers read
2792 ;; a message, alter the new message count and 2816 ;; a message, alter the new message count and
2799 (message totals-blurb)) 2823 (message totals-blurb))
2800 (if (consp (car (vm-spool-files))) 2824 (if (consp (car (vm-spool-files)))
2801 (message "No new mail for %s" 2825 (message "No new mail for %s"
2802 (or buffer-file-name (buffer-name))) 2826 (or buffer-file-name (buffer-name)))
2803 (message "No new mail.")) 2827 (message "No new mail."))
2804 (and (interactive-p) (sit-for 4) (vm-unsaved-message ""))))) 2828 (and (interactive-p) (sit-for 4) (message "")))))
2805 (t 2829 (t
2806 (let ((buffer-read-only nil) 2830 (let ((buffer-read-only nil)
2807 folder mcount totals-blurb) 2831 folder mcount totals-blurb)
2808 (setq folder (read-file-name "Gather mail from folder: " 2832 (setq folder (read-file-name "Gather mail from folder: "
2809 vm-folder-directory t)) 2833 vm-folder-directory t))
2968 vm-version) 2992 vm-version)
2969 (setq vm-startup-message-displayed t) 2993 (setq vm-startup-message-displayed t)
2970 (while (and (sit-for 4) lines) 2994 (while (and (sit-for 4) lines)
2971 (message (substitute-command-keys (car lines))) 2995 (message (substitute-command-keys (car lines)))
2972 (setq lines (cdr lines))))) 2996 (setq lines (cdr lines)))))
2973 (vm-unsaved-message "")) 2997 (message ""))
2974 2998
2975 (defun vm-load-init-file (&optional interactive) 2999 (defun vm-load-init-file (&optional interactive)
2976 (interactive "p") 3000 (interactive "p")
2977 (if (or (not vm-init-file-loaded) interactive) 3001 (if (or (not vm-init-file-loaded) interactive)
2978 (progn 3002 (progn
3165 ;; have changed. But I don't think anyone cares that 3189 ;; have changed. But I don't think anyone cares that
3166 ;; much and the summary regeneration would make this 3190 ;; much and the summary regeneration would make this
3167 ;; process slower. 3191 ;; process slower.
3168 (setq mp (cdr mp) n (1+ n)) 3192 (setq mp (cdr mp) n (1+ n))
3169 (if (zerop (% n modulus)) 3193 (if (zerop (% n modulus))
3170 (vm-unsaved-message "Converting... %d" n)))))) 3194 (message "Converting... %d" n))))))
3171 (vm-clear-modification-flag-undos) 3195 (vm-clear-modification-flag-undos)
3172 (intern (buffer-name) vm-buffers-needing-display-update) 3196 (intern (buffer-name) vm-buffers-needing-display-update)
3173 (vm-update-summary-and-mode-line) 3197 (vm-update-summary-and-mode-line)
3174 (message "Conversion complete.") 3198 (message "Conversion complete.")
3175 ;; message separator strings may have leaked into view 3199 ;; message separator strings may have leaked into view