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
|
;;; jao-frm.el --- use frm to show mailbox
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2019, 2020
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Keywords: mail
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Little hack to see the contents of your mailbox using GNU mailutils'
;; `frm' program.
;;
;; Just put (require 'jao-frm) in your .emacs, and M-x jao-frm will pop up a
;; new window with your mailbox contents (from and subject) as
;; printed by frm. In this buffer, use `n' and `p' to move, `q' to close
;; the window. `g' will call Gnus.
;;
;;; Code:
;;;; Customisation:
(defgroup jao-frm nil
"Frm-base mailbox checker"
:group 'mail
:prefix "jao-frm-")
(defcustom jao-frm-exec-path "frm"
"frm executable path"
:group 'jao-frm
:type 'file)
(defcustom jao-frm-mail-command 'gnus
"Emacs function to invoke when `g' is pressed on an frm buffer."
:group 'jao-frm
:type 'symbol)
(defcustom jao-frm-mailboxes nil
"List of mailboxes to check, or directory containing them."
:group 'jao-frm
:type '(choice directory (repeat file)))
(defface jao-frm-mailno-face '((t (:foreground "dark slate grey")))
"Face for the mail number."
:group 'jao-frm)
(defface jao-frm-from-face '((t (:foreground "slate grey")))
"Face for From: header."
:group 'jao-frm)
(defface jao-frm-subject-face '((t (:foreground "slate blue")))
"Face for Subject: header."
:group 'jao-frm)
(defface jao-frm-mailbox-face '((t (:bold t :weight bold)))
"Face for mailbox name."
:group 'jao-frm)
;;;; Mode:
(defvar jao-frm-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map [?q] 'jao-frm-delete-window)
(define-key map [?n] 'next-line)
(define-key map [?p] 'previous-line)
(define-key map [?r] 'jao-frm)
(define-key map [?g] (lambda ()
(interactive)
(funcall jao-frm-mail-command)))
(define-key map [(control k)] 'jao-frm-delete-message)
map))
(setq jao-frm-font-lock-keywords
'(("^[^ :]+:" . 'jao-frm-mailbox-face)
("^\\([ 0-9]+\\):\t+\\([^\t]+\\)\t+\\([^\n]+$\\)"
(1 'jao-frm-mailno-face)
(2 'jao-frm-from-face)
(3 'jao-frm-subject-face))))
(defvar jao-frm-mode-syntax-table
(let ((st (make-syntax-table)))
st))
(defun jao-frm-mode ()
"Major mode for displaying frm output."
(interactive)
(kill-all-local-variables)
(buffer-disable-undo)
(use-local-map jao-frm-mode-map)
(set (make-local-variable 'font-lock-defaults)
'(jao-frm-font-lock-keywords))
(set (make-local-variable 'truncate-lines) t)
(set (make-local-variable 'kill-whole-line) t)
(set (make-local-variable 'next-line-add-newlines) nil)
(setq major-mode 'jao-frm-mode)
(setq mode-name "frm")
(read-only-mode 1)
(goto-char 1))
;;;; Mode commands:
(defvar jao-frm-last-config nil)
(defun jao-frm-delete-window ()
"Delete frm window and restore last win config"
(interactive)
(if (and (consp jao-frm-last-config)
(window-configuration-p (car jao-frm-last-config)))
(progn
(set-window-configuration (car jao-frm-last-config))
(goto-char (cadr jao-frm-last-config))
(setq jao-frm-last-config nil))
(bury-buffer)))
(defun jao-frm-delete-message ()
"Delete message at point"
(interactive)
(when (eq (current-buffer) (get-buffer "*frm*"))
(beginning-of-line)
(when (search-forward-regexp "^ +\\([0-9]+\\):" nil t)
(let ((mn (string-to-number (match-string 1))))
(when (y-or-n-p (format "Delete message number %d? " mn))
(read-only-mode -1)
(shell-command (format "echo 'd %d'|mail" mn) t)
(jao-frm)
(when (= (point-max) (point-min))
(jao-frm-delete-window)
(message "Mailbox is empty")))))))
;;;; Activate frm:
(defun jao-frm-mbox-mails (mbox)
(let ((no (ignore-errors
(substring
(shell-command-to-string (format "frm -s n %s|wc -l" mbox))
0 -1))))
(if (stringp no) (string-to-number no) 0)))
(defun jao-frm-mail-number ()
(let ((no 0))
(dolist (b (jao-frm-mboxes) no) (setq no (+ no (jao-frm-mbox-mails b))))))
(defun jao-frm-default-count-formatter (m n)
(format "%s: %s" (file-name-sans-extension (file-name-nondirectory m)) n))
(defun jao-frm-mail-counts (fmt)
(let ((fmt (or fmt 'jao-frm-default-count-formatter)))
(remove nil
(mapcar (lambda (m)
(let ((n (jao-frm-mbox-mails m)))
(unless (zerop n) (funcall fmt m n))))
(jao-frm-mboxes)))))
(defun jao-frm-display-mailbox (mbox)
(when (not (zerop (jao-frm-mbox-mails mbox)))
(insert (or (file-name-nondirectory mbox) mbox) ":\n\n")
(apply 'call-process
`(,jao-frm-exec-path nil ,(current-buffer) nil
"-s" "n" "-n" "-t" ,@(and mbox (list mbox))))
(newline 2)))
(defun jao-frm-mboxes ()
(cond ((null jao-frm-mailboxes) (list (getenv "MAIL")))
((listp jao-frm-mailboxes) jao-frm-mailboxes)
((stringp jao-frm-mailboxes)
(if (file-directory-p jao-frm-mailboxes)
(directory-files jao-frm-mailboxes t "^[^.]")
(list jao-frm-mailboxes)))
(t (error "Error in mbox specification. Check `jao-frm-mailboxes'"))))
;;;###autoload
(defun jao-frm ()
"Run frm."
(interactive)
(let ((fbuff (get-buffer-create "*frm*"))
(inhibit-read-only t))
(if (not (eq fbuff (current-buffer)))
(setq jao-frm-last-config
(list (current-window-configuration) (point-marker))))
(with-current-buffer fbuff
(delete-region (point-min) (point-max))
(mapc 'jao-frm-display-mailbox (jao-frm-mboxes))
(unless (eq major-mode 'jao-frm-mode)
(jao-frm-mode))
(goto-char (point-min))
(if (= (point-min) (point-max))
(message "Mailbox is empty.")
(pop-to-buffer fbuff))
(when (and (boundp 'display-time-mode) display-time-mode)
(display-time-update)))))
;;;###autoload
(defun jao-frm-show-mail-numbers (&optional fmt)
(interactive)
(let ((counts (jao-frm-mail-counts fmt)))
(message (if counts (mapconcat 'identity counts ", ") "No mail"))))
;;;###autoload
(defun jao-frm-mail-string ()
(let ((counts (jao-frm-mail-counts
(lambda (m n)
(let ((m (substring (file-name-nondirectory m) 0 1)))
(format "%s%s" (capitalize m) n))))))
(mapconcat 'identity counts " ")))
(provide 'jao-frm)
;;; jao-frm.el ends here
|
