fr3q.el

[Joe Corneli]

,---- Joe Corneli, Re: keycounter?, Mon, 17 Feb 2003
| Is anyone aware of a key-stroke counting package for XEmacs?
| 
| In additition to tabulating the use of each key during a given session, I
| am also interested in simple statistics like frequency of pairs (e.g. how
| frequently do I type H-a followed by ordfeminine?).
`----


;;; fr3q.el -- key frequencies for emacs fr34ks

;; Copyright (C) 2005 Joe Corneli <address@hidden>

;; Time-stamp: <jac -- Sat May 14 21:51:30 CDT 2005>

;; This file is not part of GNU Emacs, but it is distributed under
;; the same terms as GNU Emacs.

;; GNU Emacs 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 2, or (at your
;; option) any later version.

;; GNU Emacs 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:

;; Initial implementation of a fairly sophisticated keycounter for
;; Emacs.  A more advanced version (as I envision it) would count keys
;; in each buffer, and present buffer-specific totals as well as grand
;; totals.  A still-more sophisticated version would do timing to
;; figure out how much time was being spent in each buffer, and give
;; character rate as well as frequency.

;;; Code:

(require 'cl)

(defvar fr3q-level 2 "Controls how many levels `fr3q-mode' considers.
Should be a value of 1, 2 or 3.  If equal to 1, only key frequencies
are considered.  If equal to 2, digraphs are considered too.  If
equal to 3, trigraphs are considered too.")

(defvar fr3q-total 0)
(defvar fr3q-printing 0)

(defvar fr3q-1graphs (make-hash-table))
(defvar fr3q-2graphs (make-hash-table :test 'equal))
(defvar fr3q-3graphs (make-hash-table :test 'equal))

(defvar fr3q-prev 'foo)
(defvar fr3q-prev2 'bar)

(defun fr3q-initialize ()
  (interactive)
  (setq fr3q-total 0
        fr3q-printing 0)
  (clrhash fr3q-1graphs)
  (clrhash fr3q-2graphs)
  (clrhash fr3q-3graphs))

(define-minor-mode fr3q-mode
  "Toggle fr3q mode.
With no argument, this command toggles the mode.
Non-null prefix argument turns on the mode.
Null prefix argument turns off the mode.

When fr3q mode is enabled, keypresses and such will be counted."
  :init-value nil
  :lighter nil
  :global t
  :keymap '()
  (when fr3q-mode
      ;; (i.e. we just turned it on)
        (add-hook 'pre-command-hook 
                  (lambda ()
                    (setq fr3q-mode-active
                          (symbol-value fr3q-mode))))
        (add-hook 'post-command-hook 
                  (lambda () 
                    (when fr3q-mode-active
                      (fr3q-process-incoming-letter
                       last-input-char)))
                  nil t)))

(defvar fr3q-mode-active nil
  "Whether or not `fr3q-mode' is active in the current buffer.")

(defun fr3q-process-incoming-letter (input)
  (puthash input (1+ (gethash input fr3q-1graphs 0)) fr3q-1graphs)
  (when (>= fr3q-level 2)
    (puthash (cons input
                   fr3q-prev)
             (1+ (gethash (cons input
                                fr3q-prev)
                          fr3q-2graphs 0)) fr3q-2graphs))
  (when (>= fr3q-level 3)
    (puthash (list input
                   fr3q-prev
                   fr3q-prev2)
             (1+ (gethash (list input
                                fr3q-prev
                                fr3q-prev2)
                          fr3q-3graphs 0)) fr3q-3graphs))
  (when (fr3q-printing-p input)
    (setq fr3q-printing (1+ fr3q-total)))
  (setq fr3q-total (1+ fr3q-total)
        fr3q-prev2 fr3q-prev
        fr3q-prev input))

(defun fr3q-printing-p (ch)
  (and (integerp ch)
       (< ch 524287)
       (or (< ch 128)
           (> ch 255))))

(defun fr3q-print ()
  (interactive)
  (set-buffer (get-buffer-create "*Emacs Fr3qs*"))
  (erase-buffer)
  (insert "Total keystrokes: " (format "%s" fr3q-total) "\n\n")
  (insert "Total printing: " (format "%s" fr3q-printing) "\n\n")
  (insert "Percent printing: " 
          (if (eq fr3q-total 0)
              "0"
            (format "%s" (/ fr3q-printing 
                            (float fr3q-total))))
          "\n\n")

  (insert "Keys:\n")
  (let (1graphs)
    (maphash (lambda (key val) 
               (setq 1graphs (cons (cons key val) 1graphs)))
             fr3q-1graphs)
    (sort 1graphs (lambda (a b) (< (cdr a) (cdr b))))
    (mapcar
     (lambda (elt)
       (insert (replace-regexp-in-string
                "-\\\\" "-"
                (replace-regexp-in-string
                 "^?\\\\?" ""
                 (format "%s %s\n" 
                         (if (integerp (car elt))
                             (prin1-char (car elt))
                           (car elt))
                         (cdr elt))))))
     (reverse 1graphs)))
  
  (when (>= fr3q-level 2)
    (insert "\nDigraphs:\n")
    (let (2graphs)
      (maphash (lambda (key val) 
                 (setq 2graphs (cons (cons key val) 2graphs)))
               fr3q-2graphs)
      (sort 2graphs (lambda (a b) (< (cdr a) (cdr b))))
      (mapcar
       (lambda (elt)
         (insert (replace-regexp-in-string
                  "-\\\\" "-"
                  (replace-regexp-in-string
                   "\\(\\`\\|+ \\)[?]\\\\?" "\\1"
                   (format "%s + %s %s\n" 
                           (let ((ch1 (car (car elt))))
                             (if (integerp ch1)
                                 (prin1-char ch1)
                               ch1))
                           (let ((ch2 (cdr (car elt))))
                             (if (integerp ch2)
                                 (prin1-char ch2)
                               ch2))
                           (cdr elt))))))
       (reverse 2graphs))))

  (when (>= fr3q-level 3)
    (insert "\nTrigraphs:\n")
    (let (3graphs)
      (maphash (lambda (key val) 
                 (setq 3graphs (cons (cons key val) 3graphs)))
               fr3q-3graphs)
      (sort 3graphs (lambda (a b) (< (cdr a) (cdr b))))
      (mapcar
       (lambda (elt)
         (insert (replace-regexp-in-string
                  "-\\\\" "-"
                  (replace-regexp-in-string
                   "\\(\\`\\|+ \\)[?]\\\\?" "\\1"
                   (format "%s + %s + %s %s\n" 
                           (let ((ch1 (first (car elt))))
                             (if (integerp ch1)
                                 (prin1-char ch1)
                               ch1))
                           (let ((ch2 (second (car elt))))
                             (if (integerp ch2)
                                 (prin1-char ch2)
                               ch2))
                           (let ((ch2 (third (car elt))))
                             (if (integerp ch2)
                                 (prin1-char ch2)
                               ch2))
                           (cdr elt))))))
       (reverse 3graphs))))

  (goto-char (point-min))
  (display-buffer "*Emacs Fr3qs*" t))

(provide 'fr3q)

;;; fr3q.el ends here