1 files changed, 222 insertions, 0 deletions
diff --git a/attic/elisp/jao-frm.el b/attic/elisp/jao-frm.el
new file mode 100644
index 0000000..2658687
--- /dev/null
+++ b/attic/elisp/jao-frm.el
@@ -0,0 +1,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