Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-summary.el @ 24:4103f0995bd7 r19-15b95

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 859a2309aef8
children 441bb1e64a06
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
293 ((fboundp 'make-extent) 293 ((fboundp 'make-extent)
294 (if (and vm-summary-overlay (extent-end-position vm-summary-overlay)) 294 (if (and vm-summary-overlay (extent-end-position vm-summary-overlay))
295 (set-extent-endpoints vm-summary-overlay start end) 295 (set-extent-endpoints vm-summary-overlay start end)
296 (setq vm-summary-overlay (make-extent start end)) 296 (setq vm-summary-overlay (make-extent start end))
297 ;; the reason this isn't needed under FSF Emacs is 297 ;; the reason this isn't needed under FSF Emacs is
298 ;; that insert-before-marker also inserts before 298 ;; that insert-before-markers also inserts before
299 ;; overlays! so a summary update of an entry just 299 ;; overlays! so a summary update of an entry just
300 ;; before this overlay in the summary buffer won't 300 ;; before this overlay in the summary buffer won't
301 ;; leak into the overlay, but it _will_ leak into an 301 ;; leak into the overlay, but it _will_ leak into an
302 ;; XEmacs extent. 302 ;; XEmacs extent.
303 (set-extent-property vm-summary-overlay 'start-open t) 303 (set-extent-property vm-summary-overlay 'start-open t)
325 (insert tokens) 325 (insert tokens)
326 (let (token) 326 (let (token)
327 (while tokens 327 (while tokens
328 (setq token (car tokens)) 328 (setq token (car tokens))
329 (cond ((stringp token) 329 (cond ((stringp token)
330 (insert token)) 330 (if vm-display-using-mime
331 (insert (vm-decode-mime-encoded-words-in-string token))
332 (insert token)))
331 ((eq token 'number) 333 ((eq token 'number)
332 (insert (vm-padded-number-of message))) 334 (insert (vm-padded-number-of message)))
333 ((eq token 'mark) 335 ((eq token 'mark)
334 (insert (vm-su-mark message))) 336 (insert (vm-su-mark message)))
335 ((eq token 'thread-indent) 337 ((eq token 'thread-indent)
442 ((= conv-spec ?*) 444 ((= conv-spec ?*)
443 (if tokenize 445 (if tokenize
444 (setq token ''mark) 446 (setq token ''mark)
445 (setq sexp (cons (list 'vm-su-mark 447 (setq sexp (cons (list 'vm-su-mark
446 'vm-su-message) sexp))))) 448 'vm-su-message) sexp)))))
449 (cond ((and (not token) vm-display-using-mime)
450 (setcar sexp
451 (list 'vm-decode-mime-encoded-words-in-string
452 (car sexp)))))
447 (cond ((and (not token) (match-beginning 1)) 453 (cond ((and (not token) (match-beginning 1))
448 (setcar sexp 454 (setcar sexp
449 (list 'vm-left-justify-string (car sexp) 455 (list 'vm-left-justify-string (car sexp)
450 (string-to-int 456 (string-to-int
451 (substring format 457 (substring format
463 (list 'vm-truncate-string (car sexp) 469 (list 'vm-truncate-string (car sexp)
464 (string-to-int 470 (string-to-int
465 (substring format 471 (substring format
466 (match-beginning 4) 472 (match-beginning 4)
467 (match-end 4))))))) 473 (match-end 4)))))))
474 (cond ((and (not token) vm-display-using-mime)
475 (setcar sexp
476 (list 'vm-reencode-mime-encoded-words-in-string
477 (car sexp)))))
468 (setq sexp-fmt 478 (setq sexp-fmt
469 (cons (if token "" "%s") 479 (cons (if token "" "%s")
470 (cons (substring format 480 (cons (substring format
471 last-match-end 481 last-match-end
472 (match-beginning 0)) 482 (match-beginning 0))
525 (if (>= (length string) width) 535 (if (>= (length string) width)
526 string 536 string
527 (concat (make-string (- width (length string)) ?\ ) string))) 537 (concat (make-string (- width (length string)) ?\ ) string)))
528 538
529 (defun vm-truncate-string (string width) 539 (defun vm-truncate-string (string width)
530 (cond ((<= (length string) width) 540 (cond
541 ;; doesn't work because the width of wide chars such as the Kanji
542 ;; glyphs as not even multiples of the default face's font width.
543 ;; ((fboundp 'char-width)
544 ;; (let ((i 0)
545 ;; (lim (length string))
546 ;; (total 0))
547 ;; (while (and (< i lim) (<= total width))
548 ;; (setq total (+ total (char-width (aref string i)))
549 ;; i (1+ i)))
550 ;; (if (<= total width)
551 ;; string
552 ;; (substring string 0 (1- i)))))
553 ((<= (length string) width)
531 string) 554 string)
532 ((< width 0) 555 ((< width 0)
533 (substring string width)) 556 (substring string width))
534 (t 557 (t
535 (substring string 0 width)))) 558 (substring string 0 width))))
809 from (or (nth 1 pair) from) 832 from (or (nth 1 pair) from)
810 full-name (or full-name (nth 0 pair) from))) 833 full-name (or full-name (nth 0 pair) from)))
811 (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name) 834 (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name)
812 (setq full-name 835 (setq full-name
813 (substring full-name (match-beginning 1) (match-end 1)))) 836 (substring full-name (match-beginning 1) (match-end 1))))
814 (setq full-name (vm-decode-mime-encoded-words-maybe full-name))
815 (while (setq i (string-match "\n" full-name i)) 837 (while (setq i (string-match "\n" full-name i))
816 (aset full-name i ?\ )) 838 (aset full-name i ?\ ))
817 (vm-set-full-name-of m full-name) 839 (vm-set-full-name-of m full-name)
818 (vm-set-from-of m from))) 840 (vm-set-from-of m from)))
819 841
887 (car list))) 909 (car list)))
888 ;; If double quoted are around the full name, fish the name out. 910 ;; If double quoted are around the full name, fish the name out.
889 (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name) 911 (if (string-match "\\`\"\\([^\"]+\\)\"\\'" full-name)
890 (setq full-name 912 (setq full-name
891 (substring full-name (match-beginning 1) (match-end 1)))) 913 (substring full-name (match-beginning 1) (match-end 1))))
892 (setq full-name (vm-decode-mime-encoded-words-maybe full-name))
893 (while (setq i (string-match "\n" full-name i)) 914 (while (setq i (string-match "\n" full-name i))
894 (aset full-name i ?\ )) 915 (aset full-name i ?\ ))
895 (setq names (cons full-name names)) 916 (setq names (cons full-name names))
896 (setq list (cdr list))) 917 (setq list (cdr list)))
897 (setq names (nreverse names)) ; added by jwz for fixed vm-parse-addresses 918 (setq names (nreverse names)) ; added by jwz for fixed vm-parse-addresses
941 (or (vm-subject-of m) 962 (or (vm-subject-of m)
942 (vm-set-subject-of 963 (vm-set-subject-of
943 m 964 m
944 (let ((subject (or (vm-get-header-contents m "Subject:" " ") "")) 965 (let ((subject (or (vm-get-header-contents m "Subject:" " ") ""))
945 (i nil)) 966 (i nil))
946 (setq subject (vm-decode-mime-encoded-words-maybe subject))
947 (while (setq i (string-match "\n" subject i)) 967 (while (setq i (string-match "\n" subject i))
948 (aset subject i ?\ )) 968 (aset subject i ?\ ))
949 subject )))) 969 subject ))))
950 970
951 (defun vm-su-summary (m) 971 (defun vm-su-summary (m)