← Back to branch summary

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

« back to all changes in this revision

Viewing changes to vm-summary.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-summary.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-summary)
 
18
;;(provide 'vm-summary)
19
19
 
20
20
(defun vm-summary-mode-internal ()
21
21
  (setq mode-name "VM Summary"
22
22
        major-mode 'vm-summary-mode
23
23
        mode-line-format vm-mode-line-format
24
24
        ;; must come after the setting of major-mode
25
 
        mode-popup-menu (and vm-use-menus vm-popup-menu-on-mouse-3
 
25
        mode-popup-menu (and vm-use-menus
26
26
                             (vm-menu-support-possible-p)
27
27
                             (vm-menu-mode-menu))
28
28
        buffer-read-only t
342
342
        (vm-decode-mime-encoded-words-in-string (eval (cdr match)))))))
343
343
 
344
344
(defun vm-summary-compile-format (format tokenize)
345
 
  (let ((return-value (vm-summary-compile-format-1 format tokenize)))
 
345
  (let ((return-value (nth 1 (vm-summary-compile-format-1 format tokenize))))
346
346
    (if tokenize
347
347
        (setq vm-summary-tokenized-compiled-format-alist
348
348
              (cons (cons format return-value)
354
354
(defun vm-tokenized-summary-insert (message tokens)
355
355
  (if (stringp tokens)
356
356
      (insert tokens)
357
 
    (let (token)
 
357
    (let (token group-list)
358
358
      (while tokens
359
359
        (setq token (car tokens))
360
360
        (cond ((stringp token)
361
361
               (if vm-display-using-mime
362
362
                   (insert (vm-decode-mime-encoded-words-in-string token))
363
363
                 (insert token)))
 
364
              ((eq token 'group-begin)
 
365
               (setq group-list (cons (list (point) (nth 1 tokens)
 
366
                                            (nth 2 tokens))
 
367
                                      group-list)
 
368
                     tokens (cdr (cdr tokens))))
 
369
              ((eq token 'group-end)
 
370
               (let* ((space (string-to-char " "))
 
371
                      (blob (car group-list))
 
372
                      (start (car blob))
 
373
                      (field-width (nth 1 blob))
 
374
                      (precision (nth 2 blob))
 
375
                      (end (vm-marker (point))))
 
376
                 (if (integerp field-width)
 
377
                     (if (< (- end start) (vm-abs field-width))
 
378
                         (if (< field-width 0)
 
379
                             (insert-char space (vm-abs (+ field-width
 
380
                                                           (- end start))))
 
381
                           (save-excursion
 
382
                             (goto-char start)
 
383
                             (insert-char space (- field-width
 
384
                                                   (- end start)))))))
 
385
                 (if (integerp precision)
 
386
                     (if (> (- end start) (vm-abs precision))
 
387
                         (if (> precision 0)
 
388
                             (delete-char (- precision (- end start)))
 
389
                           (save-excursion
 
390
                             (goto-char start)
 
391
                             (delete-char (vm-abs (+ precision
 
392
                                                     (- end start))))))))
 
393
                 (setq group-list (cdr group-list))))
364
394
              ((eq token 'number)
365
395
               (insert (vm-padded-number-of message)))
366
396
              ((eq token 'mark)
372
402
                                      (vm-th-thread-indentation message))))))
373
403
        (setq tokens (cdr tokens))))))
374
404
 
375
 
(defun vm-summary-compile-format-1 (format &optional tokenize)
 
405
(defun vm-summary-compile-format-1 (format &optional tokenize start-index)
 
406
  (or start-index (setq start-index 0))
376
407
  (let ((case-fold-search nil)
377
 
        (done nil)
 
408
        (finished-parsing-format nil)
378
409
        (list nil)
379
410
        (sexp nil)
380
411
        (sexp-fmt nil)
381
 
        (last-match-end 0)
382
 
        token conv-spec)
 
412
        (saw-close-group nil)
 
413
        (last-match-end start-index)
 
414
        new-match-end token conv-spec splice)
383
415
    (store-match-data nil)
384
 
    (while (not done)
385
 
      (setq token nil)
 
416
    (while (and (not saw-close-group) (not finished-parsing-format))
 
417
      (setq token nil
 
418
            splice nil)
386
419
      (while
387
 
          (and (not token)
 
420
          (and (not saw-close-group) (not token)
388
421
               (string-match
389
 
                "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([aAcdfFhHiIlLmMnstTwyz*%]\\|U[A-Za-z]\\)"
390
 
                format (match-end 0)))
 
422
                "%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([()aAcdfFhHiIlLmMnstTwyz*%]\\|U[A-Za-z]\\)"
 
423
                format last-match-end))
391
424
        (setq conv-spec (aref format (match-beginning 5)))
392
 
        (if (memq conv-spec '(?a ?A ?c ?d ?f ?F ?h ?H ?i ?L ?I ?l ?M
393
 
                                 ?m ?n ?s ?t ?T ?U ?w ?y ?z ?* ))
 
425
        (setq new-match-end (match-end 0))
 
426
        (if (and (memq conv-spec '(?\( ?\) ?a ?A ?c ?d ?f ?F ?h ?H ?i ?I
 
427
                                   ?l ?L ?M ?m ?n ?s ?t ?T ?U ?w ?y ?z ?* ))
 
428
                 ;; for the non-tokenized path, we don't want
 
429
                 ;; the close group spcifier processed here, we
 
430
                 ;; want to just bail out and return, which is
 
431
                 ;; accomplished by setting a flag in the other
 
432
                 ;; branch of this 'if'.
 
433
                 (or tokenize (not (= conv-spec ?\)))))
394
434
            (progn
395
 
              (cond ((= conv-spec ?a)
 
435
              (cond ((= conv-spec ?\()
 
436
                     (if (not tokenize)
 
437
                         (save-match-data
 
438
                           (let ((retval (vm-summary-compile-format-1
 
439
                                          format tokenize (match-end 5))))
 
440
                             (setq sexp (cons (nth 1 retval) sexp)
 
441
                                   new-match-end (car retval))))
 
442
                       (setq token `('group-begin
 
443
                                     ,(if (match-beginning 2)
 
444
                                          (string-to-int
 
445
                                           (concat (match-string 1 format)
 
446
                                                   (match-string 2 format))))
 
447
                                     ,(string-to-int
 
448
                                       (match-string 4 format)))
 
449
                             splice t)))
 
450
                    ((= conv-spec ?\))
 
451
                     (setq token ''group-end))
 
452
                    ((= conv-spec ?a)
396
453
                     (setq sexp (cons (list 'vm-su-attribute-indicators
397
454
                                            'vm-su-message) sexp)))
398
455
                    ((= conv-spec ?A)
520
577
                                           (match-beginning 0))
521
578
                                sexp-fmt))))
522
579
          (setq sexp-fmt
523
 
                (cons "%%"
 
580
                (cons (if (eq conv-spec ?\))
 
581
                          (prog1 "" (setq saw-close-group t))
 
582
                        "%%")
524
583
                      (cons (substring format
525
584
                                       (or last-match-end 0)
526
585
                                       (match-beginning 0))
527
586
                            sexp-fmt))))
528
 
          (setq last-match-end (match-end 0)))
529
 
      (if (not token)
 
587
          (setq last-match-end new-match-end))
 
588
      (if (and (not saw-close-group) (not token))
530
589
          (setq sexp-fmt
531
590
                (cons (substring format last-match-end (length format))
532
591
                      sexp-fmt)
533
 
                done t))
 
592
                finished-parsing-format t))
534
593
      (setq sexp-fmt (apply 'concat (nreverse sexp-fmt)))
535
594
      (if sexp
536
595
          (setq sexp (cons 'format (cons sexp-fmt (nreverse sexp))))
537
596
        (setq sexp sexp-fmt))
538
597
      (if tokenize
539
598
          (setq list (nconc list (if (equal sexp "") nil (list sexp))
540
 
                            (and token (list token)))
 
599
                            (and token (if splice token (list token))))
541
600
                sexp nil
542
601
                sexp-fmt nil)))
543
 
    (if list (cons 'list list) sexp)))
 
602
    (list last-match-end (if list (cons 'list list) sexp))))
544
603
 
545
604
(defun vm-get-header-contents (message header-name-regexp &optional clump-sep)
546
605
  (let ((contents nil)
1060
1119
       m
1061
1120
       (let ((subject (or (vm-get-header-contents m "Subject:" " ") ""))
1062
1121
             (i nil))
1063
 
         (while (setq i (string-match "\n" subject i))
1064
 
           (aset subject i ?\ ))
 
1122
         (while (string-match "\n[ \t]*" subject)
 
1123
           (setq subject (replace-match " " nil t subject)))
1065
1124
         subject ))))
1066
1125
 
1067
1126
(defun vm-su-summary (m)
1088
1147
    (while mp
1089
1148
      (vm-set-summary-of (car mp) nil)
1090
1149
      (vm-mark-for-summary-update (car mp))
1091
 
      (vm-set-modflag-of (car mp) t)
 
1150
      (vm-set-stuff-flag-of (car mp) t)
1092
1151
      (setq mp (cdr mp)))
 
1152
    (message "Stuffing attributes...")
1093
1153
    (vm-stuff-folder-attributes nil)
 
1154
    (message "Stuffing attributes... done")
1094
1155
    (set-buffer-modified-p t)
1095
1156
    (vm-update-summary-and-mode-line))
1096
1157
  (message "Fixing your summary... done"))
1097
1158
 
1098
1159
(defun vm-su-thread-indent (m)
1099
 
  (if (natnump vm-summary-thread-indent-level)
 
1160
  (if (and vm-summary-show-threads (natnump vm-summary-thread-indent-level))
1100
1161
      (make-string (* (vm-th-thread-indentation m)
1101
1162
                      vm-summary-thread-indent-level)
1102
1163
                   ?\ )
1451
1512
        major-mode 'vm-folders-summary-mode
1452
1513
        mode-line-format '("     %b")
1453
1514
        ;; must come after the setting of major-mode
1454
 
        mode-popup-menu (and vm-use-menus vm-popup-menu-on-mouse-3
 
1515
        mode-popup-menu (and vm-use-menus
1455
1516
                             (vm-menu-support-possible-p)
1456
1517
                             (vm-menu-mode-menu))
1457
1518
        buffer-read-only t
1637
1698
                  (throw 'done t))))))
1638
1699
       vm-folders-summary-hash)
1639
1700
      nil )))
 
1701
 
 
1702
(provide 'vm-summary)