mirror of
https://github.com/stumpwm/stumpwm-contrib.git
synced 2026-09-10 07:26:25 -04:00
111 lines
3.4 KiB
Common Lisp
111 lines
3.4 KiB
Common Lisp
;;;; maildir.lisp
|
||
|
||
(in-package #:maildir)
|
||
|
||
;;; "maildir" goes here. Hacks and glory await!
|
||
|
||
;;; Maildir monitoring for stumpwm's modeline
|
||
;;;
|
||
;;; Copyright 2007 Morgan Veyret.
|
||
;;;
|
||
;;; Maintainer: Morgan Veyret
|
||
;;;
|
||
|
||
;;; CODE:
|
||
|
||
(export '(*maildir-alist*
|
||
*maildir-modeline-fmt*
|
||
|
||
maildir-set-update-time))
|
||
|
||
|
||
|
||
(defvar *maildir-timer* nil)
|
||
|
||
(defvar *maildir-update-time* 900
|
||
"Time between two updates of the maildir informations (in seconds).")
|
||
|
||
(defvar *maildir-info* '()
|
||
"List of plists for number of {new,cur,tmp} mail for each mailbox")
|
||
|
||
(defvar *maildir-alist*
|
||
(list (cons "Mail" (merge-pathnames (make-pathname :directory '(:relative "Mail"))
|
||
(user-homedir-pathname))))
|
||
"Alist of pathnames to the mail directories with names. Defaults to just ~/Mail.")
|
||
|
||
(defvar *maildir-modeline-fmt* "[%l: %n] "
|
||
"The Default Value For Displaying Maildir information on the modeline.
|
||
|
||
@table @asis
|
||
@item %%
|
||
A literal '%'
|
||
@item %l
|
||
Label of the maildir
|
||
@item %n
|
||
New mails number
|
||
@item %c
|
||
Current mails number
|
||
@item %t
|
||
Temporary mails number
|
||
@end table")
|
||
|
||
|
||
|
||
(defun maildir-set-update-time (time-in-seconds)
|
||
"Set the maildir informations update interval."
|
||
(when *maildir-timer*
|
||
(cancel-timer *maildir-timer*))
|
||
(setf *maildir-update-time* time-in-seconds)
|
||
(setf *maildir-timer*
|
||
(run-with-timer *maildir-update-time* *maildir-update-time*
|
||
'update-maildir-infos)))
|
||
|
||
(defun maildir-mailboxes (maildir)
|
||
"Returns a list of all mailboxes in *maildir-path*."
|
||
(directory (merge-pathnames (make-pathname :directory '(:relative :wild))
|
||
maildir)))
|
||
|
||
(defun maildir-mailbox-dir (mailbox dir-name)
|
||
"Returns the specified sub-directory pathname for the provided mailbox."
|
||
(merge-pathnames (make-pathname :directory (list :relative dir-name)
|
||
:name :wild :type :wild)
|
||
mailbox))
|
||
|
||
(defun update-maildir-infos ()
|
||
"Update mail counts for *maildir-alist*."
|
||
(setf *maildir-info* '())
|
||
(loop for (label . dir) in *maildir-alist*
|
||
when (probe-file dir)
|
||
do (loop for m in (maildir-mailboxes dir)
|
||
sum (length (directory (maildir-mailbox-dir m "new"))) into nb-new
|
||
sum (length (directory (maildir-mailbox-dir m "cur"))) into nb-cur
|
||
sum (length (directory (maildir-mailbox-dir m "tmp"))) into nb-tmp
|
||
finally (push (list label :new nb-new :cur nb-cur :tmp nb-tmp)
|
||
*maildir-info*))))
|
||
|
||
;; modeline formatter
|
||
(defun maildir-modeline (ml)
|
||
(declare (ignore ml))
|
||
;; setup a timer to check every *maildir-update-time* seconds
|
||
;; disk access are slow and you obviously don't need to check
|
||
;; emails every time the modeline gets updated
|
||
(unless *maildir-timer*
|
||
(update-maildir-infos)
|
||
(setf *maildir-timer*
|
||
(run-with-timer *maildir-update-time* *maildir-update-time*
|
||
'update-maildir-infos)))
|
||
(loop for (label . info) in *maildir-info*
|
||
collect (stumpwm:format-expand `((#\l ,(constantly label))
|
||
(#\n ,(lambda () (format nil "^[~A~D^]"
|
||
(if (plusp (getf info :new)) "^B" "")
|
||
(getf info :new))))
|
||
(#\c ,(lambda () (format nil "~D" (getf info :cur))))
|
||
(#\t ,(lambda () (format nil "~D" (getf info :tmp)))))
|
||
*maildir-modeline-fmt*)
|
||
into fmts
|
||
finally (return (format nil "~{~A~}" fmts))))
|
||
|
||
|
||
|
||
(stumpwm:add-screen-mode-line-formatter #\D #'maildir-modeline)
|