My personal dotfiles
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

command-log-mode.el 11KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322
  1. ;;; command-log-mode.el --- log keyboard commands to buffer
  2. ;; homepage: https://github.com/lewang/command-log-mode
  3. ;; Copyright (C) 2013 Nic Ferrier
  4. ;; Copyright (C) 2012 Le Wang
  5. ;; Copyright (C) 2004 Free Software Foundation, Inc.
  6. ;; Author: Michael Weber <michaelw@foldr.org>
  7. ;; Keywords: help
  8. ;; Initial-version: <2004-10-07 11:41:28 michaelw>
  9. ;; Time-stamp: <2004-11-06 17:08:11 michaelw>
  10. ;; This file is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14. ;; This file is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17. ;; GNU General Public License for more details.
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs; see the file COPYING. If not, write to
  20. ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21. ;; Boston, MA 02111-1307, USA.
  22. ;;; Commentary:
  23. ;; This add-on can be used to demo Emacs to an audience. When
  24. ;; activated, keystrokes get logged into a designated buffer, along
  25. ;; with the command bound to them.
  26. ;; To enable, use e.g.:
  27. ;;
  28. ;; (require 'command-log-mode)
  29. ;; (add-hook 'LaTeX-mode-hook 'command-log-mode)
  30. ;;
  31. ;; To see the log buffer, call M-x clm/open-command-log-buffer.
  32. ;; The key strokes in the log are decorated with ISO9601 timestamps on
  33. ;; the property `:time' so if you want to convert the log for
  34. ;; screencasting purposes you could use the time stamp as a key into
  35. ;; the video beginning.
  36. ;;; Code:
  37. (eval-when-compile (require 'cl))
  38. (defvar clm/log-text t
  39. "A non-nil setting means text will be saved to the command log.")
  40. (defvar clm/log-repeat nil
  41. "A nil setting means repetitions of the same command are merged into the single log line.")
  42. (defvar clm/recent-history-string ""
  43. "This string will hold recently typed text.")
  44. (defun clm/recent-history ()
  45. (setq clm/recent-history-string
  46. (concat clm/recent-history-string
  47. (buffer-substring-no-properties (- (point) 1) (point)))))
  48. (add-hook 'post-self-insert-hook 'clm/recent-history)
  49. (defun clm/zap-recent-history ()
  50. (unless (or (member this-original-command
  51. clm/log-command-exceptions*)
  52. (eq this-original-command #'self-insert-command))
  53. (setq clm/recent-history-string "")))
  54. (add-hook 'post-command-hook 'clm/zap-recent-history)
  55. (defvar clm/time-string "%Y-%m-%dT%H:%M:%S"
  56. "The string sent to `format-time-string' when command time is logged.")
  57. (defvar clm/logging-dir "~/log/"
  58. "Directory in which to store files containing logged commands.")
  59. (defvar clm/log-command-exceptions*
  60. '(nil self-insert-command backward-char forward-char
  61. delete-char delete-backward-char backward-delete-char
  62. backward-delete-char-untabify
  63. universal-argument universal-argument-other-key
  64. universal-argument-minus universal-argument-more
  65. beginning-of-line end-of-line recenter
  66. move-end-of-line move-beginning-of-line
  67. handle-switch-frame
  68. newline previous-line next-line)
  69. "A list commands which should not be logged, despite logging being enabled.
  70. Frequently used non-interesting commands (like cursor movements) should be put here.")
  71. (defvar clm/command-log-buffer nil
  72. "Reference of the currenly used buffer to display logged commands.")
  73. (defvar clm/command-repetitions 0
  74. "Count of how often the last keyboard commands has been repeated.")
  75. (defvar clm/last-keyboard-command nil
  76. "Last logged keyboard command.")
  77. (defvar clm/log-command-indentation 11
  78. "*Indentation of commands in command log buffer.")
  79. (defgroup command-log nil
  80. "Customization for the command log.")
  81. (defcustom command-log-mode-auto-show nil
  82. "Show the command-log window or frame automatically."
  83. :group 'command-log
  84. :type 'boolean)
  85. (defcustom command-log-mode-window-size 40
  86. "The size of the command-log window."
  87. :group 'command-log
  88. :type 'integer)
  89. (defcustom command-log-mode-window-font-size 2
  90. "The font-size of the command-log window."
  91. :group 'command-log
  92. :type 'integer)
  93. (defcustom command-log-mode-key-binding-open-log "C-c o"
  94. "The key binding used to toggle the log window."
  95. :group 'command-log
  96. :type '(radio
  97. (const :tag "No key" nil)
  98. (key-sequence "C-c o"))) ;; this is not right though it works for kbd
  99. (defcustom command-log-mode-open-log-turns-on-mode nil
  100. "Does opening the command log turn on the mode?"
  101. :group 'command-log
  102. :type 'boolean)
  103. (defcustom command-log-mode-is-global nil
  104. "Does turning on command-log-mode happen globally?"
  105. :group 'command-log
  106. :type 'boolean)
  107. ;;;###autoload
  108. (define-minor-mode command-log-mode
  109. "Toggle keyboard command logging."
  110. :init-value nil
  111. :lighter " command-log"
  112. :keymap nil
  113. (if command-log-mode
  114. (when (and
  115. command-log-mode-auto-show
  116. (not (get-buffer-window clm/command-log-buffer)))
  117. (clm/open-command-log-buffer))
  118. ;; We can close the window though
  119. (clm/close-command-log-buffer)))
  120. (define-global-minor-mode global-command-log-mode command-log-mode
  121. command-log-mode)
  122. (defun clm/buffer-log-command-p (cmd &optional buffer)
  123. "Determines whether keyboard command CMD should be logged.
  124. If non-nil, BUFFER specifies the buffer used to determine whether CMD should be logged.
  125. If BUFFER is nil, the current buffer is assumed."
  126. (let ((val (if buffer
  127. (buffer-local-value command-log-mode buffer)
  128. command-log-mode)))
  129. (and (not (null val))
  130. (null (member cmd clm/log-command-exceptions*)))))
  131. (defmacro clm/save-command-environment (&rest body)
  132. (declare (indent 0))
  133. `(let ((deactivate-mark nil) ; do not deactivate mark in transient
  134. ; mark mode
  135. ;; do not let random commands scribble over
  136. ;; {THIS,LAST}-COMMAND
  137. (this-command this-command)
  138. (last-command last-command))
  139. ,@body))
  140. (defun clm/open-command-log-buffer (&optional arg)
  141. "Opens (and creates, if non-existant) a buffer used for logging keyboard commands.
  142. If ARG is Non-nil, the existing command log buffer is cleared."
  143. (interactive "P")
  144. (with-current-buffer
  145. (setq clm/command-log-buffer
  146. (get-buffer-create " *command-log*"))
  147. (text-scale-set 1))
  148. (when arg
  149. (with-current-buffer clm/command-log-buffer
  150. (erase-buffer)))
  151. (let ((new-win (split-window-horizontally
  152. (- 0 command-log-mode-window-size))))
  153. (set-window-buffer new-win clm/command-log-buffer)
  154. (set-window-dedicated-p new-win t)))
  155. (defun clm/close-command-log-buffer ()
  156. "Close the command log window."
  157. (interactive)
  158. (with-current-buffer
  159. (setq clm/command-log-buffer
  160. (get-buffer-create " *command-log*"))
  161. (let ((win (get-buffer-window (current-buffer))))
  162. (when (windowp win)
  163. (delete-window win)))))
  164. ;;;###autoload
  165. (defun clm/toggle-command-log-buffer (&optional arg)
  166. "Toggle the command log showing or not."
  167. (interactive "P")
  168. (when (and command-log-mode-open-log-turns-on-mode
  169. (not command-log-mode))
  170. (if command-log-mode-is-global
  171. (global-command-log-mode)
  172. (command-log-mode)))
  173. (with-current-buffer
  174. (setq clm/command-log-buffer
  175. (get-buffer-create " *command-log*"))
  176. (let ((win (get-buffer-window (current-buffer))))
  177. (if (windowp win)
  178. (clm/close-command-log-buffer)
  179. ;; Else open the window
  180. (clm/open-command-log-buffer arg)))))
  181. (defun clm/scroll-buffer-window (buffer &optional move-fn)
  182. "Updates `point' of windows containing BUFFER according to MOVE-FN.
  183. If non-nil, MOVE-FN is called on every window which displays BUFFER.
  184. If nil, MOVE-FN defaults to scrolling to the bottom, making the last line visible.
  185. Scrolling up can be accomplished with:
  186. \(clm/scroll-buffer-window buf (lambda () (goto-char (point-min))))
  187. "
  188. (let ((selected (selected-window))
  189. (point-mover (or move-fn
  190. (function (lambda () (goto-char (point-max)))))))
  191. (walk-windows (function (lambda (window)
  192. (when (eq (window-buffer window) buffer)
  193. (select-window window)
  194. (funcall point-mover)
  195. (select-window selected))))
  196. nil t)))
  197. (defmacro clm/with-command-log-buffer (&rest body)
  198. (declare (indent 0))
  199. `(when (and (not (null clm/command-log-buffer))
  200. (buffer-name clm/command-log-buffer))
  201. (with-current-buffer clm/command-log-buffer
  202. ,@body)))
  203. (defun clm/log-command (&optional cmd)
  204. "Hook into `pre-command-hook' to intercept command activation."
  205. (clm/save-command-environment
  206. (setq cmd (or cmd this-command))
  207. (when (clm/buffer-log-command-p cmd)
  208. (clm/with-command-log-buffer
  209. (let ((current (current-buffer)))
  210. (goto-char (point-max))
  211. (cond ((and (not clm/log-repeat) (eq cmd clm/last-keyboard-command))
  212. (incf clm/command-repetitions)
  213. (save-match-data
  214. (when (and (> clm/command-repetitions 1)
  215. (search-backward "[" (line-beginning-position -1) t))
  216. (delete-region (point) (line-end-position))))
  217. (backward-char) ; skip over either ?\newline or ?\space before ?\[
  218. (insert " [")
  219. (princ (1+ clm/command-repetitions) current)
  220. (insert " times]"))
  221. (t ;; (message "last cmd: %s cur: %s" last-command cmd)
  222. ;; showing accumulated text with interleaved key presses isn't very useful
  223. (when (and clm/log-text (not clm/log-repeat))
  224. (if (eq clm/last-keyboard-command 'self-insert-command)
  225. (insert "[text: " clm/recent-history-string "]\n")))
  226. (setq clm/command-repetitions 0)
  227. (insert
  228. (propertize
  229. (key-description (this-command-keys))
  230. :time (format-time-string clm/time-string (current-time))))
  231. (when (>= (current-column) clm/log-command-indentation)
  232. (newline))
  233. (move-to-column clm/log-command-indentation t)
  234. (princ (if (byte-code-function-p cmd) "<bytecode>" cmd) current)
  235. (newline)
  236. (setq clm/last-keyboard-command cmd)))
  237. (clm/scroll-buffer-window current))))))
  238. (defun clm/command-log-clear ()
  239. "Clear the command log buffer."
  240. (interactive)
  241. (with-current-buffer clm/command-log-buffer
  242. (erase-buffer)))
  243. (defun clm/save-log-line (start end)
  244. "Helper function for `clm/save-command-log' to export text properties."
  245. (save-excursion
  246. (goto-char start)
  247. (let ((time (get-text-property (point) :time)))
  248. (if time
  249. (list (cons start (if time
  250. (concat "[" (get-text-property (point) :time) "] ")
  251. "")))))))
  252. (defun clm/save-command-log ()
  253. "Save commands to today's log.
  254. Clears the command log buffer after saving."
  255. (interactive)
  256. (save-window-excursion
  257. (set-buffer (get-buffer " *command-log*"))
  258. (goto-char (point-min))
  259. (let ((now (format-time-string "%Y-%m-%d"))
  260. (write-region-annotate-functions '(clm/save-log-line)))
  261. (while (and (re-search-forward "^.*" nil t)
  262. (not (eobp)))
  263. (append-to-file (line-beginning-position) (1+ (line-end-position)) (concat clm/logging-dir now))))
  264. (clm/command-log-clear)))
  265. (add-hook 'pre-command-hook 'clm/log-command)
  266. (eval-after-load 'command-log-mode
  267. '(when command-log-mode-key-binding-open-log
  268. (global-set-key
  269. (kbd command-log-mode-key-binding-open-log)
  270. 'clm/toggle-command-log-buffer)))
  271. (provide 'command-log-mode)
  272. ;;; command-log-mode.el ends here