Download
(require 'cl)
(require 'font-lock)
(require 'view)
(defvar umemo-base-directory "~/memo/umemo"
"Directory where memo files are placed.
You need not create directory when it does not exist.
usage-memo creates it automatically.")
(defvar umemo-separator "\n===*===*===*===*===*===*===*===*===*===*===\n"
"Separator between documentation and memo.")
(defvar umemo-category nil
"Category of usage-memo. It is defined by `define-usage-memo'.")
(defvar umemo-entry-name nil
"Entry name that help buffer(per buffer) is showing. It is used as filename of annotation.")
(defvar umemo-orig-major-mode nil
"Major mode when `usage-memo-mode' turn on.")
(defvar umemo-current-entry-name nil
"Entry name that help buffer(globally) is showing. See also `umemo-entry-name'.
It is needed because some help system (eg. SLIME) kills help
buffer and re-create it. In this case, the buffer-local
`umemo-entry-name' is cleared: I have no choice but to use global
variable. But it is probaby rare case.")
(make-variable-buffer-local 'umemo-category)
(make-variable-buffer-local 'umemo-entry-name)
(make-variable-buffer-local 'umemo-orig-major-mode)
(defvar umemo-auto-change-major-mode-flag t
"If non-nil, change major mode to `umemo-second-mode' when point is below the separator.")
(defvar umemo-second-mode 'org-mode
"Major mode to write a usage memo.")
(defvar umemo-change-major-mode-flag nil)
(defun umemo-pathname (category entry-name)
"Filename of annotation. `umemo-base-directory'/CATEGORY/ENTRY-NAME."
(format "%s/%s/%s" umemo-base-directory category entry-name))
(defun umemo-fall-back-to-global-key-binding-in-memo-area (key)
(let* ((lb (local-key-binding key))
(gb (global-key-binding key)))
(call-interactively
(cond ((umemo-point-is-in-memo-area-p (point)) gb)
(lb lb)
(t gb)))))
(defun umemo-point-is-in-memo-area-p (point)
(save-excursion
(goto-char point)
(search-backward umemo-separator nil t)))
(defmacro umemo-with-append-to-buffer (buffer &rest body)
"Execute BODY at the end of BUFFER."
`(save-excursion
(set-buffer buffer)
(goto-char (point-max))
,@body))
(defmacro umemo-if-buffer-has-separator (&rest body)
`(save-excursion
(goto-char (point-min))
(when (search-forward umemo-separator nil t)
,@body)))
(defun umemo-has-entry-p ()
(save-excursion
(goto-char (point-min))
(and (search-forward umemo-separator nil t)
(/= (point) (point-max)))))
(defun umemo-insert-memo (category entry-name buffer)
(let ((path (umemo-pathname category entry-name)))
(umemo-with-append-to-buffer buffer
(setq buffer-read-only nil)
(unless (umemo-has-entry-p)
(insert umemo-separator)
(and (file-exists-p path) (insert-file-contents path))))))
(defun umemo-setup-variables (category entry-name buffer)
(setq umemo-current-entry-name entry-name)
(with-current-buffer buffer
(setq umemo-category category
umemo-entry-name entry-name
umemo-orig-major-mode major-mode)))
(put 'umemo-category 'permanent-local t)
(put 'umemo-entry-name 'permanent-local t)
(put 'umemo-orig-major-mode 'permanent-local t)
(defun umemo-change-mode (mode)
(when (and (fboundp mode)
(not (eq major-mode mode)))
(funcall mode)
(usage-memo-mode 1)
(umemo-auto-change-major-mode-setup)
(if (eq font-lock-mode t)
(font-lock-fontify-buffer))))
(defun umemo-update-mode ()
(when (and umemo-auto-change-major-mode-flag
umemo-change-major-mode-flag)
(if (save-excursion (search-forward umemo-separator nil t))
(umemo-change-mode umemo-orig-major-mode)
(umemo-change-mode umemo-second-mode))))
(add-hook 'post-command-hook 'umemo-update-mode)
(defun umemo-auto-change-major-mode-setup ()
(set (make-local-variable 'umemo-change-major-mode-flag) t))
(defun umemo-setup (category entry-name buffer)
(when (get-buffer buffer)
(with-current-buffer buffer
(umemo-setup-variables category entry-name buffer)
(umemo-insert-memo category entry-name buffer)
(usage-memo-mode 1))))
(defun umemo-save ()
"Save current usage memo(annotation) into file."
(interactive)
(umemo-if-buffer-has-separator
(let* ((path (umemo-pathname umemo-category umemo-entry-name))
(dir (file-name-directory path)))
(unless (file-directory-p dir) (make-directory dir t))
(write-region (point) (point-max) path)
(set-buffer-modified-p nil)
(message "Wrote %s" path))))
(defun umemo-electric-return ()
(interactive)
(umemo-fall-back-to-global-key-binding-in-memo-area "\r"))
(defun umemo-electric-quit ()
(interactive)
(if (umemo-point-is-in-memo-area-p (point))
(call-interactively (global-key-binding "q"))
(and (view-mode 1) (View-quit))))
(defvar buffer-fmt)
(defmacro define-usage-memo (command category nth-arg buffer-fmt &optional name-converter-function)
"Add usage-memo feature to COMMAND.
Define `usage-memo' around-advice for COMMAND.
CATEGORY is usage-memo category to use, typically language name.
NTH-ARG is COMMAND's argument position (0-origin) representing entry name,
NTH-ARG is passed to `ad-get-arg' macro.
BUFFER-FMT is a `format' string, which %s is replaced with entry name,
representing document display buffer.
Optional NAME-CONVERTER-FUNCTION is 1-argument function
to convert COMMAND's argument (indicated by NTH-ARG) to entry name.
Of course, the default is `identity'.
NAME-CONVERTER-FUNCTION can be used when the entry name is determined by document-displaying buffer contents.
BUFFER-FMT is bound when NAME-CONVERTER-FUNCTION is called.
For example: To support `describe-function' (already supported):
(define-usage-memo describe-function \"elisp\" 0 \"*Help*\")
Because `define-usage-memo' is a macro, COMMAND is not quoted.
The CATEGORY is \"elisp\". The NTH-ARG is 0 because
`describe-function' takes a symbol to lookup at the first
argument. Because NTH-ARG is 0-origin, 0 means the first
argument. BUFFER-FMT is same as *Help* buffer: it is only
coincidental.
Another example: Support RI lookup (Ruby's document-lookup tool)
`ri' function is defined in ri-ruby.el. The usage is:
(ri ENTRY_NAME)
Then `ri' creates
ri `ENTRY_NAME'
buffer. Instead of reusing a buffer, it creates a buffer per query.
That is why BUFFER-FMT uses `format' string!
(define-usage-memo ri \"ruby\" 0 \"ri `%s'\")
SLIME example: Downcase Lisp's symbol
(define-usage-memo slime-show-description \"cl\" 0 \"*SLIME Description*\" umemo-make-entry-name:slime)
See also `umemo-initialize' definition.
"
(let ((converter (or name-converter-function 'identity)))
`(defadvice ,command (around usage-memo activate)
ad-do-it
(let* ((buffer-fmt ,buffer-fmt)
(entry-name (funcall ',converter (format "%s" (ad-get-arg ,nth-arg))))
(buf (with-no-warnings (format ,buffer-fmt entry-name))))
(umemo-setup ,category entry-name buf)))))
(defun umemo-initialize ()
"A bunch of `define-usage-memo' definitions. Feel free to redefine!"
(define-usage-memo ri "ruby" 0 "ri `%s'")
(define-usage-memo lh-refe "ruby" 0 "refe \"%s\"")
(define-usage-memo slime-show-description "cl" 0 "*SLIME Description*" umemo-make-entry-name:slime)
(define-usage-memo describe-function "elisp" 0 "*Help*")
(define-usage-memo describe-variable "elisp" 0 "*Help*")
(define-usage-memo describe-mode "elisp" 0 "*Help*"
(lambda (arg) major-mode)))
(defvar usage-memo-mode-map (make-sparse-keymap))
(define-key usage-memo-mode-map "\C-x\C-s" 'umemo-save)
(define-key usage-memo-mode-map "\r" 'umemo-electric-return)
(define-key usage-memo-mode-map "q" 'umemo-electric-quit)
(define-minor-mode usage-memo-mode
"Automatically enabled minor mode to add usage-memo feature by `define-usage-memo'.
Write your annotation below `===*===*===*===*===*===*===*===*===*===*===' line.
\\<usage-memo-mode-map>\\[umemo-save]: Save your annotation to file indicated by `umemo-pathname'.
Of course, your annotation is revived even if Emacs is restarted!
"
nil "<UMemo>" usage-memo-mode-map
:global nil
(setq buffer-read-only nil)
(when view-mode (view-mode -1))
(setq header-line-format (format "[%s/%s]" umemo-category umemo-entry-name))
(umemo-auto-change-major-mode-setup)
(buffer-enable-undo))
(defun umemo-make-entry-name:slime (symbol-name)
(downcase (umemo-slime-get-full-symbol-name buffer-fmt)))
(defun umemo-slime-get-full-symbol-name (buf)
"Get common lisp full symbol name describing in BUF. Currently it supports SBCL, CMUCL and CLISP.
If you want to adjust to other CL implementations, redefine this function."
(flet ((srch (re num) (and (re-search-forward re nil t) (match-string num)))
(srcheq (re num str) (equal (srch re num) str)))
(save-excursion
(set-buffer buf)
(goto-char (point-min))
(apply
#'concat
(reverse
(list (srch "^\\(.+:+\\)?\\([^ ]+\\)" 2)
(if (or (srcheq "an \\(internal\\|external\\) symbol" 1 "internal")
(save-excursion (srcheq "SYMBOL-PLIST[^:]+\\(:+\\)" 1 "::")))
"::" ":")
(or (srch "#<PACKAGE \"\\(.+\\)\">" 1)
(srch "in the \\(.+\\) package" 1)
(srch "#<PACKAGE \\(.+\\)>" 1))))))))
(defvar umemo-maintainer-mail-address
(concat "rubiki" "tch@ru" "by-lang.org"))
(defvar umemo-bug-report-salutation
"Describe bug below, using a precise recipe.
When I executed M-x ...
How to send a bug report:
1) Be sure to use the LATEST version of usage-memo.el.
2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t)
3) Use Lisp version instead of compiled one: (load \"usage-memo.el\")
4) If you got an error, please paste *Backtrace* buffer.
5) Type C-c C-c to send.
# If you are a Japanese, please write in Japanese:-)")
(defun umemo-send-bug-report ()
(interactive)
(reporter-submit-bug-report
umemo-maintainer-mail-address
"usage-memo.el"
(apropos-internal "^u\\(sage-\\)?memo-" 'boundp)
nil nil
umemo-bug-report-salutation))
(provide 'usage-memo)