← Back to branch summary

~ubuntu-branches/ubuntu/hardy/vm/hardy

« back to all changes in this revision

Viewing changes to vm-thread.el

  • Committer: Bazaar Package Importer
  • Author(s): Manoj Srivastava
  • Date: 2005-05-02 23:57:59 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050502235759-lsq60hinwkchrbxp
Tags: 7.19-4
http://bugs.debian.org/306876
http://bugs.debian.org/303519
* Bug fix: "vm: Please do not discriminate against XEmacs", thanks to
  Dirk Eddelbuettel. Well, back in the mists of time, VM was packaged to
  be byte-compiled for XEmacs, but the XEmacs maintainer at that time
  asked me to cease and desist. Times change, so that is reverted. 
                                                        (Closes: #306876).
* Bug fix: "vm: purge doesn't", thanks to Ian Zimmerman. This should be
  better.                                               (Closes: #303519).

Show diffs side-by-side

added added

removed removed

Lines of Context:
vm-thread.el
15
15
;;; along with this program; if not, write to the Free Software
16
16
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
17
17
 
18
 
(provide 'vm-thread)
 
18
;;(provide 'vm-thread)
19
19
 
20
20
(defun vm-toggle-threads-display ()
21
21
  "Toggle the threads display on and off.
25
25
  (interactive)
26
26
  (vm-select-folder-buffer)
27
27
  (vm-check-for-killed-summary)
 
28
  ;; get numbering of new messages done now
 
29
  ;; so that the sort code only has to worry about the
 
30
  ;; changes it needs to make.
 
31
  (vm-update-summary-and-mode-line)
28
32
  (vm-set-summary-redo-start-point t)
29
33
  (setq vm-summary-show-threads (not vm-summary-show-threads))
30
34
  (if vm-summary-show-threads
32
36
    (vm-sort-messages "physical-order")))
33
37
 
34
38
(defun vm-build-threads (message-list)
35
 
  (if (null vm-thread-obarray)
 
39
  (if (not (vectorp vm-thread-obarray))
36
40
      (setq vm-thread-obarray (make-vector 641 0)
37
41
            vm-thread-subject-obarray (make-vector 641 0)))
38
42
  (let ((mp (or message-list vm-message-list))
50
54
            id-sym (intern id vm-thread-obarray)
51
55
            date (vm-so-sortable-datestring m))
52
56
      (put id-sym 'messages (cons m (get id-sym 'messages)))
 
57
      (put id-sym 'date date)
53
58
      (if (and (null (cdr (get id-sym 'messages)))
54
59
               schedule-reindents)
55
60
          (vm-thread-mark-for-summary-update (get id-sym 'children)))
117
122
              ;; information vector.
118
123
              (if (not (boundp subject-sym))
119
124
                  (set subject-sym
120
 
                       (vector id-sym (vm-so-sortable-datestring m)
 
125
                       (vector id-sym date
121
126
                               nil (list m)))
122
127
                ;; this subject seen before 
123
128
                (aset (symbol-value subject-sym) 3
191
196
  (let ((done nil)
192
197
        (m message)
193
198
        (loop-recovery-point nil)
194
 
        thread-list id-sym subject-sym loop-sym root-date)
 
199
        (date (vm-so-sortable-datestring message))
 
200
        thread-list id-sym subject-sym loop-sym root-date youngest-date)
195
201
    (save-excursion
196
202
      (set-buffer (vm-buffer-of m))
197
203
      (fillarray vm-thread-loop-obarray 0)
202
208
        ;; save the date of the oldest message in this thread
203
209
        (setq root-date (get id-sym 'oldest-date))
204
210
        (if (or (null root-date)
205
 
                (string< (vm-so-sortable-datestring message) root-date))
206
 
            (put id-sym 'oldest-date (vm-so-sortable-datestring message)))
 
211
                (string< date root-date))
 
212
            (put id-sym 'oldest-date date))
 
213
        ;; save the date of the youngest message in this thread
 
214
        (setq youngest-date (get id-sym 'youngest-date))
 
215
        (if (or (null root-date)
 
216
                (string< youngest-date date))
 
217
            (put id-sym 'youngest-date date))
207
218
        (if (and (boundp id-sym) (symbol-value id-sym))
208
219
            (progn
209
220
              (setq id-sym (symbol-value id-sym)
254
265
          m id-sym subject-sym vect p-sym)
255
266
      (while mp
256
267
        (setq m (car mp))
257
 
        (let ((inhibit-quit t))
258
 
          (vm-set-thread-list-of m nil)
259
 
          (vm-set-thread-indentation-of m nil)
260
 
          (set-buffer (vm-buffer-of m))
261
 
          (setq id-sym (intern (vm-su-message-id m) vm-thread-obarray)
262
 
                subject-sym (intern (vm-so-sortable-subject m)
263
 
                                    vm-thread-subject-obarray))
264
 
          (if (boundp id-sym)
265
 
              (progn
266
 
                (put id-sym 'messages (delq m (get id-sym 'messages)))
267
 
                (vm-thread-mark-for-summary-update (get id-sym 'children))
268
 
                (setq p-sym (symbol-value id-sym))
269
 
                (and p-sym (put p-sym 'children
270
 
                                (delq m (get p-sym 'children))))
271
 
                (if message-changing
272
 
                    (set id-sym nil))))
273
 
          (if (and (boundp subject-sym) (setq vect (symbol-value subject-sym)))
274
 
              (if (not (eq id-sym (aref vect 0)))
275
 
                  (aset vect 2 (delq m (aref vect 2)))
276
 
                (if message-changing
277
 
                    (if (null (cdr (aref vect 3)))
278
 
                        (makunbound subject-sym)
279
 
                      (let ((p (aref vect 3))
280
 
                            oldest-msg oldest-date children)
281
 
                        (setq oldest-msg (car p)
282
 
                              oldest-date (vm-so-sortable-datestring (car p))
283
 
                              p (cdr p))
284
 
                        (while p
285
 
                          (if (and (string-lessp (vm-so-sortable-datestring (car p))
286
 
                                                 oldest-date)
287
 
                                   (not (eq m (car p))))
288
 
                              (setq oldest-msg (car p)
289
 
                                    oldest-date (vm-so-sortable-datestring (car p))))
290
 
                          (setq p (cdr p)))
291
 
                        (aset vect 0 (intern (vm-su-message-id oldest-msg)
292
 
                                             vm-thread-obarray))
293
 
                        (aset vect 1 oldest-date)
294
 
                        (setq children (delq oldest-msg (aref vect 2)))
295
 
                        (aset vect 2 children)
296
 
                        (aset vect 3 (delq m (aref vect 3)))
297
 
                        ;; I'm not sure there aren't situations
298
 
                        ;; where this might loop forever.
299
 
                        (let ((inhibit-quit nil))
300
 
                          (vm-thread-mark-for-summary-update children))))))))
 
268
        (set-buffer (vm-buffer-of m))
 
269
        (if (not (vectorp vm-thread-obarray))
 
270
            nil
 
271
          (let ((inhibit-quit t))
 
272
            (vm-set-thread-list-of m nil)
 
273
            (vm-set-thread-indentation-of m nil)
 
274
            (setq id-sym (intern (vm-su-message-id m) vm-thread-obarray)
 
275
                  subject-sym (intern (vm-so-sortable-subject m)
 
276
                                      vm-thread-subject-obarray))
 
277
            (if (boundp id-sym)
 
278
                (progn
 
279
                  (put id-sym 'messages (delq m (get id-sym 'messages)))
 
280
                  (vm-thread-mark-for-summary-update (get id-sym 'children))
 
281
                  (setq p-sym (symbol-value id-sym))
 
282
                  (and p-sym (put p-sym 'children
 
283
                                  (delq m (get p-sym 'children))))
 
284
                  (if message-changing
 
285
                      (set id-sym nil))))
 
286
            (if (and (boundp subject-sym) (setq vect (symbol-value subject-sym)))
 
287
                (if (not (eq id-sym (aref vect 0)))
 
288
                    (aset vect 2 (delq m (aref vect 2)))
 
289
                  (if message-changing
 
290
                      (if (null (cdr (aref vect 3)))
 
291
                          (makunbound subject-sym)
 
292
                        (let ((p (aref vect 3))
 
293
                              oldest-msg oldest-date children)
 
294
                          (setq oldest-msg (car p)
 
295
                                oldest-date (vm-so-sortable-datestring (car p))
 
296
                                p (cdr p))
 
297
                          (while p
 
298
                            (if (and (string-lessp (vm-so-sortable-datestring (car p))
 
299
                                                   oldest-date)
 
300
                                     (not (eq m (car p))))
 
301
                                (setq oldest-msg (car p)
 
302
                                      oldest-date (vm-so-sortable-datestring (car p))))
 
303
                            (setq p (cdr p)))
 
304
                          (aset vect 0 (intern (vm-su-message-id oldest-msg)
 
305
                                               vm-thread-obarray))
 
306
                          (aset vect 1 oldest-date)
 
307
                          (setq children (delq oldest-msg (aref vect 2)))
 
308
                          (aset vect 2 children)
 
309
                          (aset vect 3 (delq m (aref vect 3)))
 
310
                          ;; I'm not sure there aren't situations
 
311
                          ;; where this might loop forever.
 
312
                          (let ((inhibit-quit nil))
 
313
                            (vm-thread-mark-for-summary-update children)))))))))
301
314
          (setq mp (cdr mp))))))
302
315
 
303
316
(defun vm-th-references (m)
337
350
      (progn
338
351
        (vm-set-thread-list-of m (vm-thread-list m))
339
352
        (vm-thread-list-of m))))
 
353
 
 
354
(provide 'vm-thread)