-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy path.wl
2640 lines (2459 loc) · 98 KB
/
.wl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;;;
;;;; .wl.el - Wanderlust custom configuration
;;;;
;;;;#ident "@(#)HOME:.wl 37.11 25/03/07 14:08:52 (woods)"
;;;;
;; XXX look for ideas in <URL:http://triaez.kaisei.org/~kaoru/emacsen/startup/init-mua.el>
;;
;; See also https://www.emacswiki.org/emacs/WlFaq
;; N.B.: the following packages are effectively required:
;;
;; graphics/compface
;; security/gnupg2 ; with security/pinentry
;; textproc/aspell ; or...
;; textproc/ispell
;;
;; OpenSSL is also required (for "openssl s_client:)
;;
;; Some emacs packages listed in ~/.emacs.el will also be needed.
;;
;; Changing the following may require deletion of ~/elmo/cache/*
;;
;; wl-message-sort-field-list
;; wl-message-ignored-field-list
;; elmo-msgdb-extra-fields
;; FixMe:
;;
;; `undo' should mark a message as unread if the last action was to view it.
;; do not display diary at midnight (it messes with window configurations!)
(if (boundp 'appt-display-diary)
(setq appt-display-diary nil))
;; Try to make the mouse/trackpad scroll the window more "smoothly"
;;
;; DO NOT EVER move the cursor with scroll input (unless doing so to keep it
;; within the current window).
;;
(eval-after-load "wl-summary"
'(progn
(define-key wl-summary-mode-map [mouse-4] 'mwheel-scroll)
(define-key wl-summary-mode-map [mouse-5] 'mwheel-scroll)
(define-key wl-summary-mode-map [S-mouse-4] 'mwheel-scroll)
(define-key wl-summary-mode-map [S-mouse-5] 'mwheel-scroll)))
(eval-after-load "wl-folder"
'(progn
(define-key wl-folder-mode-map [mouse-4] 'mwheel-scroll)
(define-key wl-folder-mode-map [mouse-5] 'mwheel-scroll)
(define-key wl-folder-mode-map [S-mouse-4] 'mwheel-scroll)
(define-key wl-folder-mode-map [S-mouse-5] 'mwheel-scroll)))
;;; XXX This doesn't work right at all.... The resulting keymap looks like a
;;; total mess with multiple bindings for [mouse-4] et al.
;;;
;;; maybe it's easier to redefine `wl-message-wheel-up' and
;;;`wl-message-wheel-down'?
;;;
;;; alternatively one might redefine `wl-message-define-keymap' entirely instead
;;;
;(eval-after-load "wl-message"
; '(progn
; (define-key wl-message-button-map [mouse-4] 'mwheel-scroll)
; (define-key wl-message-button-map [mouse-5] 'mwheel-scroll)
; (define-key wl-message-button-map [S-mouse-4] 'mwheel-scroll)
; (define-key wl-message-button-map [S-mouse-5] 'mwheel-scroll)))
;;;
(eval-after-load "wl-message"
'(defun wl-message-define-keymap ()
(let ((keymap (make-sparse-keymap)))
(define-key keymap "D" 'wl-message-delete-current-part)
(define-key keymap "l" 'wl-message-toggle-disp-summary)
(define-key keymap "\C-c:d" 'wl-message-decrypt-pgp-nonmime)
(define-key keymap "\C-c:v" 'wl-message-verify-pgp-nonmime)
(define-key keymap "w" 'wl-draft)
;; XXX redefining the mouse wheel behaviour to do anything other than scroll
;; by line is EVIL
; (define-key keymap [mouse-4] 'wl-message-wheel-down)
; (define-key keymap [mouse-5] 'wl-message-wheel-up)
; (define-key keymap [S-mouse-4] 'wl-message-wheel-down)
; (define-key keymap [S-mouse-5] 'wl-message-wheel-up)
(set-keymap-parent wl-message-button-map keymap)
(define-key wl-message-button-map
[mouse-2] 'wl-message-button-dispatcher)
keymap))
)
;; alternately, from Kzuhiro Ito <hzhr@d1.dion.ne.jp>, this should work:
;
;(advice-add 'wl-message-define-keymap
; :around
; (lambda (oldfun &rest r)
; (let ((keymap (apply oldfun r)))
; (define-key keymap [mouse-4] 'mwheel-scroll)
; (define-key keymap [mouse-5] 'mwheel-scroll)
; (define-key keymap [S-mouse-4] 'mwheel-scroll)
; (define-key keymap [S-mouse-5] 'mwheel-scroll)
; keymap))
; '((name . "Disable wl-message-wheel-* functions")))
;; same for mime-view, but maybe this doesn't work so well?
;; xxx maybe setting `mime-view-mode-default-map' doesn't work???
;;
(eval-after-load "mime-view"
'(progn
(define-key mime-view-mode-default-map [mouse-4] 'mwheel-scroll)
(define-key mime-view-mode-default-map [mouse-5] 'mwheel-scroll)
(define-key mime-view-mode-default-map [S-mouse-4] 'mwheel-scroll)
(define-key mime-view-mode-default-map [S-mouse-5] 'mwheel-scroll)))
;; make scrolling back work in the message view
;; xxx maybe setting `mime-view-mode-default-map' doesn't work???
;;
(define-key mime-view-mode-default-map "b" 'mime-preview-scroll-down-entity)
;; turn off scoring for speed -- I never use it anyway
;;
(setq wl-use-scoring nil)
;; don't leave my passwords sitting in memory too long!
;;
;; (use `elmo-passwd-alist-clear' to manually clear cache and start over)
;;
(setq elmo-passwd-life-time 14400) ; 4 hrs
;; let's try this for use with wl-refile-guess-by-from and use of "%INBOX/from"
;; as wl-refile-default-from-folder in particular since it doesn't seem to be
;; able to do anything any smarter than to concatenate the mailbox string onto
;; this prefix, thus there's no way to specify a server name in the default.
;;
;; a better solution would be to use a call to `format' to expand
;; wl-refile-default-from-folder, with "%s" in the position where the folder
;; name should be placed
;;
(setq elmo-imap4-default-server "mailbox.weird.com")
;(setq elmo-imap4-debug t) ;; for tracing the IMAP session
(setq elmo-imap4-force-login t) ;; hmmm... is this necessary with my Cyrus IMAPd?
;(setq elmo-imap4-debug-inhibit-login-logging-default nil) ;; for trying to trace login, but using my own still-unpublished hacks
;; Check these folders for new mail
;;
;(setq wl-biff-check-folder-list
; '("%INBOX:\"user@gmail.com\"/clear@imap.gmail.com:993"
; "%INBOX:\"user@other.domain\"/clear@imapserver.other.domain:993"))
;;
;; Use strict diff so wl-biff works with Gmail and others
;;
;(setq wl-strict-diff-folders wl-biff-check-folder-list)
;; Check for mail every 60 seconds
;;
(setq wl-biff-check-interval 60)
;; Check only when idle
;;
(setq wl-biff-use-idle-timer t)
;; `mail-local-domain-name' comes from my ~/.emacs.el
;;
(setq wl-local-domain (or mail-local-domain-name "example.org"))
;; Use SSL connection
;;
;; N.B.: You MUST install WanderLust with `wl-install-utils' set in WL-CFG
;;
;(setq elmo-imap4-default-stream-type 'starttls)
(setq elmo-imap4-default-stream-type 'ssl)
(setq elmo-imap4-default-port 993)
;; ... else don't use SSL...
;; XXX WARNING XXX: only safe if IMAP host & network to it is 100% secure!
;(setq elmo-imap4-default-stream-type nil)
;(setq elmo-imap4-default-port 143)
;; This is required for some reason in order for imap.gmail.com connections to
;; work (note that it would work with `1' ("Verification required"), but this
;; seems safer.
;;
;; `3' means "Reject connection if verification fails"
;;
;(setq ssl-certificate-verification-policy 3)
(setq tls-checktrust 'ask)
;(setq tls-program
; '("gnutls-cli --insecure -p %p %h"))
; ;; https://github.com/wanderlust/wanderlust/issues/166
; (setq gnutls-verify-error nil) ; xxx ???
; (setq gnutls-min-prime-bits 1024)
; (setq gnutls-algorithm-priority "SECURE128:-VERS-SSL3.0:-VERS-TLS1.3")
;; XXX why did I never set `ssl-program-name' ???
;(setq ssl-program-arguments
; '("s_client"
; "-tls1" ; new mailbox.weird.com requires TLSv1 (or SSLv3)
; "-quiet"
; "-host" host
; "-port" service
; "-verify" (int-to-string ssl-certificate-verification-policy)
; "-CApath" ssl-certificate-directory))
;; XXX new .../net/tls.el is very different!
;(setq tls-program
; '("openssl s_client -tls1 -quiet -host %h -port %p"))
;; password always sent in the clear for my servers (over TLS, of course)
;;
(setq elmo-imap4-default-authenticate-type 'clear)
;; this is needed to make sure filenames created to save attachments are sane
;;
(setq filename-filters '(filename-special-filter))
(defun string-matched (search strings)
(while (and strings (not (string-match search (car strings))))
(setq strings (cdr strings)))
(car strings))
;; Directory where icons are placed (XXX should be set by configuration!)
;;
;; N.B.: the icons-big versions are created with a copy, then:
;;
;; mogrify -resize 200% *
;;
;; (mogrify is from ImageMagick)
;;
(eval-and-compile
(defvar wl-icon-directory-ORIGINAL wl-icon-directory
"original value at startup")
)
(setq wl-icon-directory
(cond ;((let ((icons
; (expand-file-name "icons/"
; (string-matched "/wanderlust" load-path))))
; (if (file-directory-p icons)
; icons)))
;; n.b.: the first will almost certainly always win, but keep these
;; for posterity:
((let ((icons
(expand-file-name (cond ((and (boundp 'display-y-dpi)
display-y-dpi
(>= display-y-dpi 110))
"../../wl/icons-big/")
(t
"../../wl/icons/"))
(cond ((boundp 'local-site-lisp-dir)
local-site-lisp-dir)
((boundp 'pkg-site-lisp-dir)
pkg-site-lisp-dir)))))
(if (file-directory-p icons)
icons)))
((let ((icons
(expand-file-name (cond ((and (boundp 'display-y-dpi)
display-y-dpi
(>= display-y-dpi 110))
"icons-big/")
(t
"icons/"))
(cond ((and (boundp 'package-alist)
(fboundp 'package-desc-dir))
(package-desc-dir
(cadr (assq 'wanderlust
package-alist))))
(t
nil)))))
(if (file-directory-p icons)
icons)))
((let ((icons
(expand-file-name (cond ((and (boundp 'display-y-dpi)
display-y-dpi
(>= display-y-dpi 110))
"wl/icons-big/")
(t
"wl/icons/"))
data-directory)))
(if (file-directory-p icons)
icons)))
(t
nil)))
;; prefetch everything that's uncached, not just unread-uncached (U) and
;; new-uncached (N)
;;
;; aka: (setq wl-summary-incorporate-marks '("N" "U" "!" "A" "F" "$"))
;;
;; Visiting any folder will now pre-fetch all messages.
;;
;; Also one can explicity call `wl-folder-prefetch-current-entity' (bound to I
;; in the Folder buffer).
;;
;(setq wl-summary-incorporate-marks
; (list wl-summary-uncached-mark
; wl-summary-new-uncached-mark
; wl-summary-unread-uncached-mark
; wl-summary-answered-uncached-mark))
;;
;; XXX _HOWEVER_ prefetching is extremely slow! but this does not stop it!
;;
;(setq wl-summary-incorporate-marks nil)
;(setq wl-summary-force-prefetch-folder-list nil) ; is the default
(setq wl-stay-folder-window t)
;; support for marking messages addressed "to-me" in the Summary buffer.
;;
;; (Uses `wl-address-user-mail-address-p', thus `wl-user-mail-address-regexp' if
;; non-nil, else `wl-user-mail-address-list'.)
;;
;; By Ron Isaacson with thanks to Erik Hetzner for some fixes:
;;
(defun wl-summary-line-to-me ()
"Return `*' if current message is addressed to me, else ` '."
(let ((all-addresses (append
(elmo-message-entity-field wl-message-entity 'to t)
(elmo-message-entity-field wl-message-entity 'cc t)))
(to-me nil))
(while (and all-addresses
(not to-me))
(setq to-me (wl-address-user-mail-address-p (car all-addresses)))
(setq all-addresses (cdr all-addresses)))
(if to-me "*" " ")))
;; add "%E" to `wl-summary-line-format' to invoke `wl-summary-line-to-me'
;;
(setq wl-summary-line-format-spec-alist
(put-alist '?E
'((wl-summary-line-to-me))
wl-summary-line-format-spec-alist))
;; fancier summaries. Default: ugly :-)
;;
(setq wl-summary-default-number-column 6) ; message numbers are often 6 digits with Cyrus IMAP
(setq wl-summary-width nil)
;; after changing `wl-summary-line-format' you need to exit and re-enter the
;; Summary buffer to update the displayed format.
(setq wl-summary-line-format (concat "%n %T"
"%P %E %[%20(%c %f%) %] %Y/%M/%D(%W)%h:%m %-8S%-2@ %t%~\"%s\" \t"))
(setq wl-summary-default-view 'sequence)
;; never search for thread parent messages by subject!
;;
(setq wl-summary-search-parent-by-subject-regexp nil)
;; xxx unfortunately this is results in an either-or list, with no way to
;; combine various flags and statuses to, for example, show an "Important" but
;; answered message with the same background as the "important" flag, and also
;; with the grey strike-through of an answered message (IFF answered is above
;; important)
(setq wl-summary-persistent-mark-priority-list '(killed
deleted
draft
answered
forwarded
redirected
flag ; user-defined flag!?!?!? (XXX standin for all of them?)
shouldreply
junk
important
special
private
todo
personal
work
new
unread
notjunk
nonjunk))
;; default is blank (white on white) on monochrome displays!
;;
;; XXX for this to work correctly (i.e. be display-independent), the COLOR
;; field must be a full display face created by `defface'.
;;
;; XXX in the mean time maybe we should also check the result of:
;;
;; (frame-parameter nil 'display-type) ; (or does `display-color-p' just do that?)
;;
(if (display-color-p)
(setq wl-summary-flag-alist '((ignore "dim gray" " ")
(important "black" "I") ; see later set-face-attribute
(private "blue" "P")
(todo "dark red" "T")
(personal "dark blue" "p")
(business "forest green" "W")
(work "dark green" "w")
(forwarded "medium blue" "F")
(redirected "dark cyan" "R")
(killed "grey" "K")
(junk "SlateGray" "J")
(unread "black" "O") ; xxx hmmm, probably not what I think
(flag "black" "?") ; xxx doesn't seem to work completely (still get `wl-summary-flag-mark')
(junkrecorded "black" " ") ; xxx actually should be whatever is in force without the flag!
(notjunk "black" " ")
))
;; else not colour...
(setq wl-summary-flag-alist '((ignore "black" " ")
(important "black" "I")
(private "black" "P")
(todo "black" "T")
(personal "black" "p")
(business "black" "W")
(work "black" "w")
(forwarded "black" "F")
(redirected "black" "R")
(killed "black" "K")
(unread "black" "O") ; xxx hmmm, probably not what I think
(junk "black" "J")
(flag "black" "?")
;;(junkrecorded "black" " ")
;;(notjunk "black" " ")
)))
;; XXX unfortunately just calling `defface' again to try to redefine a face
;; does not work.
;;
;(wl-defface wl-highlight-summary-deleted-face
; '((((type tty)
; (background dark))
; (:foreground "red"))
; (((class grayscale)
; (background dark))
; (:foreground "grey"))
; (((class mono)
; (background dark))
; (:foreground "white" :strike-through t))
; (((class mono)
; (background light))
; (:foreground "black" :strike-through t))
; (((class color)
; (background dark))
; (:foreground "red" :strike-through "OrangeRed"))
; (((class color)
; (background light))
; (:foreground "IndiaRed3" :strike-through "black"))
; (t
; (:strike-through t)))
; "Face used for displaying messages that have been marked to be deleted."
; :group 'wl-summary-faces
; :group 'wl-faces)
(defun my-wl-init-stuff ()
"Setup stuff run at the end of `wl-init'."
(require 'wl-highlight)
;; some faces are not defined until after `wl-init'...
(if (display-color-p)
;; xxx hmmm... some themes do wl stuff, others do not...
(if (eq (frame-parameter nil 'background-mode) 'light)
(progn
;; message view
(set-face-attribute 'wl-highlight-message-headers
nil
:foreground "black")
;; Summary
(set-face-attribute 'wl-highlight-summary-new-face
nil
:foreground "dark red")
(set-face-attribute 'wl-highlight-summary-unread-face
nil
:foreground "black")
(set-face-attribute 'wl-highlight-summary-answered-face
nil
:foreground "sea green"
:strike-through "grey")
(set-face-attribute 'wl-highlight-summary-resend-face
nil
:foreground "blue")
;; here "flagged" means _ANY_ flag!
(set-face-attribute 'wl-highlight-summary-flagged-face
nil
:foreground "magenta"
:background "white")
(set-face-attribute 'wl-highlight-summary-deleted-face
nil
:foreground "red"
:strike-through "orange red")
(set-face-attribute 'wl-highlight-summary-disposed-face
nil
:foreground "saddle brown"
:strike-through "orange red")
;; Flagged (see wl-summary-flag-alist for primary settings -- the
;; corresponding entry in wl-summary-flag-alist must exist for these
;; to work)
(set-face-attribute 'wl-highlight-summary-important-flag-face
nil
:background "lemon chiffon")
(set-face-attribute 'wl-highlight-summary-personal-flag-face
nil
:background "cornsilk")
(set-face-attribute 'wl-highlight-summary-work-flag-face
nil
:background "light cyan")
(set-face-attribute 'wl-highlight-summary-redirected-flag-face
nil
:foreground "brown") ; xxx doesn't work?
;; xxx this is not the same as `wl-highlight-summary-junk-face'
(set-face-attribute 'wl-highlight-summary-junk-flag-face
nil
:foreground "SlateGray"
:strike-through "LightGray")
;;; XXX grrr.....
;;; (set-face-attribute 'wl-highlight-summary-notjunk-flag-face
;;; nil
;;; :foreground "black")
;; Folder
(set-face-attribute 'wl-highlight-folder-few-face
nil
:foreground "firebrick")
(set-face-attribute 'wl-highlight-folder-many-face
nil
:foreground "red")
(set-face-attribute 'wl-highlight-folder-opened-face
nil
:foreground "dark green")
(set-face-attribute 'wl-highlight-folder-unknown-face
nil
:foreground "blue")
(set-face-attribute 'wl-highlight-folder-unread-face
nil
:foreground "black")
)
;; else background-mode dark(?)
(progn
;; message view
(set-face-attribute 'wl-highlight-message-headers
nil
:foreground "white")
;; Summary
(set-face-attribute 'wl-highlight-summary-new-face
nil
:background "black"
:foreground "white")
(set-face-attribute 'wl-highlight-summary-flagged-face
nil
:background "black"
:foreground "yellow")
(set-face-attribute 'wl-highlight-summary-important-flag-face
nil
:background "black"
:foreground "white")
;;; XXX How to make this always the same as "normal" where normal might be dynamic???
;;; (set-face-attribute 'wl-highlight-summary-junkrecorded-flag-face
;;; nil
;;; :background "black"
;;; :foreground "white")
(set-face-attribute 'wl-highlight-summary-ignore-flag-face
nil
:background "black"
:foreground "blue")
(set-face-attribute 'wl-highlight-summary-deleted-face
nil
:foreground "orange red"
:strike-through "red")
(set-face-attribute 'wl-highlight-summary-disposed-face
nil
:foreground "dark orange"
:strike-through "orange red")
)
)
;; else not color display:
(set-face-attribute 'wl-highlight-summary-deleted-face nil
:strike-through t)))
(add-hook `wl-init-hook `my-wl-init-stuff)
;; show recipient in summary %f column of all folders when sender is me
;;
(setq wl-summary-showto-folder-regexp ".*")
(setq wl-summary-from-function 'wl-summary-default-from)
(setq wl-summary-move-direction-toggle nil) ; and don't waffle!!!
(setq wl-summary-move-direction-downward t) ; just always go DOWN
(setq wl-summary-exit-next-move nil) ; don't move the Folder pointer on quit
;; don't automatically try to sync all "marks", as this causes enormous delays
;; when loading large infrequently visited folders. Use "s mark <return>" to do
;; it intentionally.
;;
(setq wl-summary-auto-sync-marks nil)
;; to decode encoded words within quoted strings in headers....
;;
;; NOTE: normally this is contrary to the standards, I think, so it should not
;; be necessary, but of course some stupid mailers always quote every display
;; name regardless of whether it needs quoting or not, and perhaps sometimes
;; even when it must not be quoted, such as when it is encoded.
;;
;; Also, you have to refresh the summary after you change this if the header is
;; shown in a summary column.
;;
;; XXX This still doesn't allow for improperly encoded headers, such as when
;; spaces are not encoded:
;;
;; Subject: =?UTF-8?Q?DNEvents.com Inc. invites you to 8th Toronto Domainer Dinner (Apr 23, 2009)?=
;;
;; XXX these are not decoded either:
;;
;; Subject: =?utf-8?Q?We=e2=80=99re_updating_our_Privacy_Policy_and_tools?=
;; From: "=?utf-8?Q?feedback=40slack=2ecom?=" <feedback@slack.com>
;; From: =?UTF-8?Q?Isma=c3=abl_Tanguy?= <ismael.tanguy@univ-brest.fr>
;;
;; N.B.: `rfc2047-decode-string' handles all of the above just fine.
;;
(setq mime-header-accept-quoted-encoded-words t)
(defun my-wl-summary-turn-off-disp-msg ()
"Unconditionally turn off message display so that I don't fat-finger myself
into too much confusion (use this for bindings to `delete-other-windows')."
(interactive)
(wl-summary-toggle-disp-msg 'off)
;; the default effectively turned off the Folder window too because it called
;; `delete-other-windows', but with a wide display that's NOT what I want to
;; do any more.
;;
;; note: long ago there was code in `wl-summary-toggle-disp-msg' that hid the
;; folder window when displaying the summary, but it was commented out.
;;
;; Also kill any raw buffer window
;;
(save-excursion
(let ((raw-msg-buf (get-buffer "*wl:raw message*")))
(when raw-msg-buf
(switch-to-buffer-other-window raw-msg-buf)
(kill-buffer-and-window))))
)
(define-key wl-summary-mode-map "\C-x1" 'my-wl-summary-turn-off-disp-msg)
(require 'advice)
(defadvice wl-summary-sync-force-update (before my-wl-summary-sync-force-update activate)
"Turn off message display before updating the summary."
(wl-summary-toggle-disp-msg 'off))
;; maybe this could probably be done with `defadvice'?
;; xxx this is not exactly a good mimic to `wl-summary-mark-as-unread' as it
;; does not really follow the API for wl-summary commands
;; xxx should also wrap `wl-summary-mark-as-unread-region'
(defun my-wl-summary-mark-as-unread (&optional arg)
"Mark the current message as unread.
If ARG is non-nil, forget everything about the message."
(interactive "P")
(cond
((null (wl-summary-message-number))
(message "No message."))
(arg
(wl-summary-toggle-disp-msg 'off)
(wl-message-buffer-cache-clean-up)
(wl-summary-delete-cache)))
(wl-summary-mark-as-unread))
(define-key wl-summary-mode-map "!" 'my-wl-summary-mark-as-unread)
(define-key wl-summary-mode-map "c" 'wl-jump-to-draft-buffer) ; 'c'ontinue
(define-key wl-summary-mode-map "b" 'wl-summary-prev-page)
(define-key wl-summary-mode-map "g" 'wl-summary-sync-force-update)
(define-key wl-summary-mode-map "G" 'wl-summary-goto-folder)
;; 's' is currently bound to `wl-summary-sync', which is infinitely more useful!!!
;(define-key wl-summary-mode-map "s" 'wl-summary-save)
(define-key wl-summary-mode-map "\M-n" 'wl-summary-down)
(define-key wl-summary-mode-map "\M-p" 'wl-summary-up)
(define-key wl-folder-mode-map "\M-n" 'wl-folder-next-unread)
(define-key wl-folder-mode-map "\M-p" 'wl-folder-prev-unread)
;; make 'q' in a virtual folder (created by 'V') return to the folder from
;; which it was created, just as 'C-u V' does, instead of quitting to the
;; Folder buffer (from Yoichi NAKAYAMA on the wl-en list)
;;
(add-hook 'wl-summary-prepared-hook
(lambda ()
(setq wl-summary-buffer-exit-function
(when (eq 'filter
(elmo-folder-type-internal wl-summary-buffer-elmo-folder))
'wl-summary-unvirtual))))
;; Just setting wl-summary-subject-function to point to the identity function
;; will work, but perhaps other callers of the munging version of this function
;; would also appreciate just seeing the original text un-touched. At worst
;; this might botch subject-based threading,
;;
(setq wl-summary-subject-function 'identity)
(defun wl-summary-default-subject (subject-string)
subject-string)
(defun my-wl-summary-exec-and-rescan ()
"Run `wl-summary-exec' and then immediately run `wl-summary-sync-force-update'."
(interactive)
(wl-summary-toggle-disp-msg 'off)
;;
;; XXX this is only a tiny example of what I really want
;;
;; I would like to see something more like the little confirmation display
;; created by wl-draft-send-confirm such that the number of deletes, moves,
;; copies, raw deletes, etc. can be shown, and optionally detailed, before
;; their execution is confirmed.
;;
(if (yes-or-no-p (format "Execute %d marks? " (length wl-summary-buffer-temp-mark-list)))
(wl-summary-exec))
(wl-summary-sync-force-update))
;; turn off dangerous commands with too-simple-to-hit keys
;;
(define-key wl-summary-mode-map "x" nil)
(define-key wl-summary-mode-map "X" 'my-wl-summary-exec-and-rescan)
(define-key wl-summary-mode-map "\C-c\C-c" 'my-wl-summary-exec-and-rescan) ; complete selection
(setq wl-thread-insert-opened t) ; XXX do we want to see the opened threads?
;; xxx this is a copy just to add `interactive'
(defun wl-summary-goto-top-of-current-thread ()
(interactive)
(wl-summary-jump-to-msg
(wl-thread-entity-get-number
(wl-thread-entity-get-top-entity (wl-thread-get-entity
(wl-summary-message-number))))))
(define-key wl-summary-mode-map "tt" 'wl-thread-goto-top-of-current-thread)
(define-key wl-summary-mode-map "\C-\M-a" 'wl-summary-goto-top-of-current-thread)
(define-key wl-summary-mode-map "tn" 'wl-thread-goto-bottom-of-sub-thread)
(define-key wl-summary-mode-map (kbd "C-M-)") 'wl-thread-goto-bottom-of-sub-thread)
;(setq wl-auto-prefetch-first nil) ; is the default
;(setq wl-auto-select-first nil) ; is the default
;; using `skip-no-unread' with the following is has unfortunate side effects if
;; the space bar is held down in auto-repeat mode as the confirmation character
;; is in fact "SPC".
;;
(setq wl-auto-select-next nil) ; is the default
;; found this on a Japanese mailing list with hints that this is the proper way
;; to use "always buffer local" `wl-summary-buffer-*-folder-function' variables
;; which according to the code will completely avoid triggering anything to do
;; with auto-selecting the next or previous folder when navigating past the end
;; or beginning of a "Summary" buffer
;;
(add-hook 'wl-summary-mode-hook
'(lambda ()
(setq wl-summary-buffer-prev-folder-function 'ignore
wl-summary-buffer-next-folder-function 'ignore)))
(setq wl-message-buffer-prefetch-idle-time 10)
;(setq wl-message-buffer-prefetch-depth 1) ; is the default
;(setq wl-prefetch-confirm t) ; is the default
(setq wl-message-buffer-prefetch-threshold 1000000)
;(setq elmo-message-fetch-confirm t) ; is the default
(setq elmo-message-fetch-threshold 5000000)
;; additional fields to retrieve when fetching headers
;;
;; (also appear in the '?' and 'V' lists, though arbitrary fields can be given
;; to those functions to do a direct search on the server)
;;
;; The following list is automatically prepended:
;;
;; '("Subject" "From" "To" "Cc" "Date"
;; "Message-Id" "References" "In-Reply-To")
;;
(setq elmo-msgdb-extra-fields '("Delivered-To"
"List-Id"
"Precedence"
"Received"
"Reply-To"
"Return-Path"
"Sender"
"X-Priority"))
;; xxx necessary for now to support "%@" in `wl-summary-line-format'
;; (rebuild message db for all folders after adding this: s all <RETURN>)
;;
(add-to-list 'elmo-msgdb-extra-fields "Content-Type")
;; XXX over-ride the search function to give a better prompt:
;;
(defun wl-read-search-condition (default)
"Read search condition string interactively."
(wl-read-search-condition-internal "Search by (arbitrary header allowed)" default))
;; the following would require an .xbm filename in `x-face-default-xbm-file'
;;
;; (add-hook 'wl-mail-setup-hook 'x-face-insert)
;;
;; so instead we use the old "X-Face:" literal text content file created by
;; compface...
;;
(setq wl-x-face-file "~/.face")
(add-hook 'wl-draft-insert-x-face-field-hook
(lambda nil
(x-face-insert wl-x-face-file)))
;; ~/.emacs.el should find and load x-face-e21 if it is available....
;;
(if (fboundp 'x-face-decode-message-header)
(setq wl-highlight-x-face-function 'x-face-decode-message-header))
(if (fboundp 'x-face-save)
(define-key wl-summary-mode-map "\C-x4s" 'x-face-save))
(if (fboundp 'x-face-ascii-view)
(define-key wl-summary-mode-map "\C-x4a" 'x-face-ascii-view))
(if (fboundp 'x-face-insert)
(define-key wl-draft-mode-map "\C-x4i" 'x-face-insert))
(if (fboundp 'x-face-show)
(define-key wl-draft-mode-map "\M-\C-t" 'x-face-show))
;; for header effects
;;
;(setq wl-highlight-message-header-alist ...)
;; show all the headers except those we know we don't care about... (Note that
;; any `*-view-visible-field-list' value overwhelm's the `*-ignored-field-list'
;; value)
;;
(setq wl-message-visible-field-list nil) ; was '("^Dnas.*:" "^Message-Id:")
(setq mime-view-visible-field-list nil) ; was '("^Dnas.*:" "^Message-Id:")
(setq wl-message-ignored-field-list
'("[^:]*Received:"
"[^:]*Path:"
"[^:]*Sender:" ; include X-Sender, X-X-Sender, etc.
"[^:]*Host:"
"^ARC-Authentication-Results:"
"^ARC-Message-Signature:"
"^ARC-Seal:"
"^Authentication-Results:"
"^Autocrypt:" ; interesting, but contains huge key data
"^Content[^:]*:" ; irrelevant! :-)
"^DKIM-Signature:" ; useless junk
"^DomainKey[^:]*:" ; bogus junk
"^Errors-To:"
"^In-Reply-To:" ; just another message-id
"^IronPort-[^:]*:" ; some silly AV crapware
"^Lines:"
"^List-[^:]*:" ; rfc????
"^Message-I[dD]:" ; RFC 2036 too!
"^MIME-Version:" ; irrelevant! :-)
"^Received-SPF:" ; supid and meaningless!
"^References:"
"^Replied:"
"^Status:"
"^Thread-Index:"
"^Topicbox-Delivery-ID:"
"^Topicbox-Message-UUID:"
"^UI-OutboundReport:"
"^X-Accept-Language:"
"^x-authority-analysis:"
"^X-Barracuda[^:]*:" ; some stupid virus scanner
"^X-BeenThere:" ; mailman?
"^X-Brightmail-Tracker:"
"^X-Cam[^:]*:" ; some stupid virus scanner
"^X-CanItPRO[^:]*:"
"^X-CSC:"
"^X-CHA:"
"^X-CMAE-Envelope:"
"^X-CTCH-[^:]*:"
"^X-ImunifyEmail-Filter-Info:"
"^X-Exchange[^:]*:" ; M$-Exchange
"^X-Filter-ID:"
"^X-Forefront[^:]*:"
"^X-GMX[^:]*:"
"^X-Gm-Gg:"
"^X-Gm-Message-State:"
"^X-Google-DKIM-Signature:"
"^X-Google-Smtp-Source:"
"^X-Greylist[^:]*:"
"^X-Hashcash[^:]*:" ; ???
"^X-IPAS-Result:"
"^X-IronPort[^:]*:" ; some silly AV crapware
"^X-Junkmail[^:]*:" ; mirapoint???
"^X-MAil-Count:" ; fml?
"^X-ME-[^:]*:"
"^X-MIME-Autoconverted:"
"^X-Microsoft[^:]*:" ; M$-Exchange
"^X-Mirapoint[^:]*:" ; mirapoint???
"^X-ML[^:]*:" ; fml
"^X-MS-[^:]*:"
"^X-MSAMetaData:"
"^X-MSAPipeline:"
"^X-Mailman[^:]*:" ; mailman
"^X-OriginalArrivalTime:"
"^X-PMAS-[^:]*:"
"^X-PMX[^:]*:"
"^X-Provags-[^:]*:"
"^X-OQ-[^:]*:"
"^X-Received-Authentication-Results:"
"^X-RPI[^:]*:"
"^X-SG-EID:"
"^X-SKK:"
"^X-SMTP-Spam-[^:]*:"
"^X-SONIC-DKIM-SIGN:"
"^X-Scanned[^:]*:"
"^X-Sieve:" ; cyrus
"^X-Spam[^:]*:"
"^X-UI-Out-Filterresults:"
"^X-UI-Sender-Class:"
"^X-VADE-[^:]*:"
"^X-VM-[^:]*:"
"^X-Virus[^:]*:"
"^X-VR-[^:]*:"
"^X-YMail-OSG:" ; some Mozilla mailer?
"^Xref:"
; "^X-Original-To:" ; fml?
))
;; try to use some hand-coded rules instead of relying entirely on BBDB
;;
;; first though make sure these rules come after the auto-learned subject and
;; msgid (thread-like) rules, but after the from and tocc auto-learned so that
;; the auto-learning rules (that make sense) have precedence
;;
(setq wl-refile-guess-functions
'(wl-refile-guess-by-subject
wl-refile-guess-by-msgid
wl-refile-guess-by-rule
wl-refile-guess-by-from
wl-refile-guess-by-history))
;;
;; Sadly this is a prefix, not a format pattern, so no server name can be included
;;
(setq wl-refile-default-from-folder "%INBOX/from")
;;
(setq wl-refile-rule-alist
'(("Subject"
("^\\[Acct Event\\] " . "%INBOX/planix/aci/db-trouble-tickets@mailbox.weird.com"))
("Subject"
("Aurora Cable Abuse Department" . "%INBOX/planix/aci/abuse@mailbox.weird.com"))
("Subject"
("\\[SpamCop " . ("To"
(".*@.*aci\\.on\\.ca" . "%INBOX/planix/aci/abuse@mailbox.weird.com"))))
(("To" "Cc" "From" "Sender")
("\\(jennifer@.*\\(wrede\\|planix\\).*\\|jen\\(nifer\\)?\\.wrede@.*\\)"
. "%INBOX/from/jennifer@mailbox.weird.com"))
(("To" "Cc")
("\\(abuse\\|[hp]ostmaster\\|info\\|support\\)@.*aci\\.on\\.ca"
. "%INBOX/planix/aci/\\1@mailbox.weird.com"))
("From"
("\\(abuse\\|[hp]ostmaster\\|info\\|support\\)@.*aci\\.on\\.ca"
. "%INBOX/planix/aci/\\1@mailbox.weird.com"))))
;; we do want all the received headers on forwarded messages, but not any other
;; locally added headers
;;
(setq wl-ignored-forwarded-headers
"\\(return-path\\|x-sieve\\|x-uidl\\)")
;; enable WL as the default mail composer
(if (boundp 'mail-user-agent) ; from simple.el in emacs-21
(setq mail-user-agent 'wl-user-agent))
(if (fboundp 'define-mail-user-agent)
(define-mail-user-agent
'wl-user-agent
'wl-user-agent-compose
'wl-draft-send
'wl-draft-kill
'mail-send-hook))
;; pull in all the MIME stuff (why does it seem we must do this here?)
(require 'elmo-mime)
(require 'mel)
(require 'mime-edit)
(require 'mime-view)
;; XXX a better URL regex:
;;
(if (elisp-file-in-loadpath-p "browse-url")
(progn
(require 'browse-url)
;;
;; hmmm.... should be a better/more-complete regex, but N.B.:
;;
;; "This variable was introduced in version 27.1 of Emacs"
;;
;; N.B.: Newer WL will have a fix as well....
;;
(if (boundp 'browse-url-button-regexp)
(setq mime-browse-url-regexp browse-url-button-regexp)
(setq mime-browse-url-regexp
;; stolen from the future.....
(concat
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|"
"nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)"
"\\(//[-a-z0-9_.]+:[0-9]*\\)?"
(let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]")
(punct "!?:;.,"))
(concat
"\\(?:"
;; Match paired parentheses, e.g. in Wikipedia URLs:
;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com [dead link]
"[" chars punct "]+" "(" "[" chars punct "]+" ")"
"\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?"
"\\|"
"[" chars punct "]+" "[" chars "]"
"\\)"))