1 ;;; howm-misc.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2015, 2016
3 ;;; HIRAOKA Kazuyuki <khi@users.sourceforge.jp>
4 ;;; $Id: howm-misc.el,v 1.96 2012-12-29 08:57:18 hira Exp $
6 ;;; This program is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 1, or (at your option)
11 ;;; This program is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; The GNU General Public License is available by anonymouse ftp from
17 ;;; prep.ai.mit.edu in pub/gnu/COPYING. Alternately, you can write to
18 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
20 ;;;--------------------------------------------------------------------
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 (defun howm-version ()
30 (message "howm-%s" howm-version))
32 (defun howm-keyword-file ()
34 (when (not (file-exists-p howm-keyword-file))
36 (find-file howm-keyword-file)
38 (goto-char (point-min))
39 (insert howm-menu-top "\n"))
40 (set-buffer-modified-p t)
43 (message "Generating %s ..." howm-keyword-file)
44 (howm-keyword-add-items (howm-all-items))
48 (add-hook 'howm-view-open-hook 'howm-set-mode)
49 (defun howm-set-mode ()
50 (when (howm-set-mode-p)
51 (howm-set-configuration-for-major-mode major-mode)
54 (defun howm-set-mode-p (&optional buf)
55 (with-current-buffer (or buf (current-buffer))
56 (let ((hdir (car (howm-search-path))))
57 (and (buffer-file-name)
58 (howm-folder-territory-p hdir (buffer-file-name))))))
60 (defvar howm-configuration-for-major-mode nil)
62 ;; (setq howm-configuration-for-major-mode
67 ;; (howm-keyword-format . "(def[a-z*]+ +%s[ \t\r\n]")
68 ;; (howm-keyword-regexp-format . "%s")
69 ;; (howm-keyword-regexp . "(\\(def[a-z]+\\) +'?\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)") ;; ' for (defalias 'xxx ...)
70 ;; (howm-keyword-regexp-hilit-pos . 1)
71 ;; (howm-keyword-regexp-pos . 2)
72 ;; (howm-view-title-regexp . "^(.*$")
73 ;; ;; (howm-view-title-regexp . "^[^; \t\r\n].*$")
74 ;; (howm-view-title-regexp-pos . 0)
75 ;; (howm-view-title-regexp-grep . "^[^; \t\r\n].*$")
76 ;; (howm-mode-title-face . nil)
77 ;; (howm-keyword-list-alias-sep . nil)
78 ;; (howm-view-preview-narrow . nil)
82 ;; (howm-keyword-format . "(def[a-z]+ +[(]?%s[) \t\r\n]")
83 ;; (howm-keyword-regexp-format . "%s")
84 ;; (howm-keyword-regexp . "(\\(def[a-z]+\\) +[(]?\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)")
85 ;; (howm-keyword-regexp-hilit-pos . 1)
86 ;; (howm-keyword-regexp-pos . 2)
87 ;; (howm-view-title-regexp . "^[^; \t\r\n].*$")
88 ;; (howm-view-title-regexp-pos . 0)
89 ;; (howm-view-title-regexp-grep . "^[^; \t\r\n].*$")
90 ;; (howm-mode-title-face . nil)
91 ;; (howm-keyword-list-alias-sep . nil)
92 ;; (howm-view-preview-narrow . nil)
96 ;; (howm-keyword-format . "\\(def\\|class\\) +%s\\b")
97 ;; (howm-keyword-regexp-format . "%s")
98 ;; (howm-keyword-regexp . "\\(def\\|class\\) +\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)")
99 ;; (howm-keyword-regexp-hilit-pos . 1)
100 ;; (howm-keyword-regexp-pos . 2)
101 ;; (howm-view-title-regexp . "^[^# \t\r\n].*$")
102 ;; (howm-view-title-regexp-pos . 0)
103 ;; (howm-view-title-regexp-grep . "^[^# \t\r\n].*$")
104 ;; (howm-mode-title-face . nil)
105 ;; (howm-keyword-list-alias-sep . nil)
106 ;; (howm-view-preview-narrow . nil)
110 ;; (howm-keyword-format . "\\\\label%s")
111 ;; (howm-keyword-regexp-format . "%s")
112 ;; (howm-keyword-regexp . "\\(\\\\label\\)\\({[^}\r\n]+}\\)")
113 ;; (howm-keyword-regexp-hilit-pos . 1)
114 ;; (howm-keyword-regexp-pos . 2)
115 ;; (howm-view-title-regexp . "\\\\\\(\\(sub\\)*section\\|chapter\\|part\\|begin\\)")
116 ;; (howm-view-title-regexp-pos . 0)
117 ;; (howm-view-title-regexp-grep . "\\\\((sub)*section|chapter|part|begin)")
118 ;; (howm-mode-title-face . nil)
119 ;; (howm-keyword-list-alias-sep . nil)
120 ;; (howm-view-preview-narrow . nil)
124 (defun howm-set-configuration-for-file-name (f)
125 (let ((mode (howm-auto-mode f)))
126 (howm-set-configuration-for-major-mode mode)))
128 (defun howm-set-configuration-for-major-mode (mode)
129 (let ((a (cdr (assoc mode howm-configuration-for-major-mode))))
130 (when a ;; I know this is redundant.
132 (let ((symbol (car sv))
134 (set (make-local-variable symbol) value)))
137 (defmacro howm-if-unbound (var &rest alt-body)
138 `(if (boundp ',var) ,var ,@alt-body))
140 ;; copied and modified from set-auto-mode in /usr/share/emacs/21.2/lisp/files.el
141 ;; (I don't want to set the mode actually. Sigh...)
142 (howm-dont-warn-free-variable auto-mode-interpreter-regexp)
143 (defvar howm-auto-mode-interpreter-regexp
144 (howm-if-unbound auto-mode-interpreter-regexp
145 ;; xemacs doesn't have it.
146 "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)"))
147 (defun howm-auto-mode (&optional file-name)
148 "Major mode appropriate for current buffer.
149 This checks for a -*- mode tag in the buffer's text,
150 compares the filename against the entries in `auto-mode-alist',
151 or checks the interpreter that runs this file against
152 `interpreter-mode-alist'.
154 It does not check for the `mode:' local variable in the
155 Local Variables section of the file; for that, use `hack-local-variables'.
157 If `enable-local-variables' is nil, this function does not check for a
160 This function merely returns the mode; it does not set the mode.
162 ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
163 (let (beg end done modes ans)
165 (goto-char (point-min))
166 (skip-chars-forward " \t\n")
167 (and enable-local-variables
168 ;; Don't look for -*- if this file name matches any
169 ;; of the regexps in inhibit-first-line-modes-regexps.
170 (let ((temp (howm-if-unbound inhibit-first-line-modes-regexps
171 inhibit-local-variables-regexps))
172 (name (file-name-sans-versions (or file-name ""))))
173 (while (let ((sufs (howm-if-unbound inhibit-first-line-modes-suffixes
174 inhibit-local-variables-suffixes)))
175 (while (and sufs (not (string-match (car sufs) name)))
176 (setq sufs (cdr sufs)))
178 (setq name (substring name 0 (match-beginning 0))))
180 (not (string-match (car temp) name)))
181 (setq temp (cdr temp)))
183 (search-forward "-*-" (save-excursion
184 ;; If the file begins with "#!"
185 ;; (exec interpreter magic), look
186 ;; for mode frobs in the first two
187 ;; lines. You cannot necessarily
188 ;; put them in the first line of
189 ;; such a file without screwing up
190 ;; the interpreter invocation.
191 (end-of-line (and (looking-at "^#!") 2))
194 (skip-chars-forward " \t")
196 (search-forward "-*-"
197 (save-excursion (end-of-line) (point))
201 (skip-chars-backward " \t")
204 (if (save-excursion (search-forward ":" end t))
205 ;; Find all specifications for the `mode:' variable
206 ;; and execute them left to right.
207 (while (let ((case-fold-search t))
208 (or (and (looking-at "mode:")
209 (goto-char (match-end 0)))
210 (re-search-forward "[ \t;]mode:" end t)))
211 (skip-chars-forward " \t")
213 (if (search-forward ";" end t)
216 (skip-chars-backward " \t")
217 (push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
219 ;; Simple -*-MODE-*- case.
220 (push (intern (concat (downcase (buffer-substring beg end))
223 ;; If we found modes to use, set done.
224 (dolist (mode (nreverse modes))
225 (when (functionp mode)
228 ;; If we didn't find a mode from a -*- line, try using the file name.
229 (if (and (not done) file-name)
230 (let ((name file-name)
232 ;; Remove backup-suffixes from file name.
233 (setq name (file-name-sans-versions name))
235 (setq keep-going nil)
236 (let ((alist auto-mode-alist)
238 ;; Find first matching alist entry.
239 (let ((case-fold-search
240 (memq system-type '(vax-vms windows-nt))))
241 (while (and (not mode) alist)
242 (if (string-match (car (car alist)) name)
243 (if (and (consp (cdr (car alist)))
245 (setq mode (car (cdr (car alist)))
246 name (substring name 0 (match-beginning 0))
248 (setq mode (cdr (car alist))
250 (setq alist (cdr alist))))
253 ;; If we can't deduce a mode from the file name,
254 ;; look for an interpreter specified in the first line.
255 ;; As a special case, allow for things like "#!/bin/env perl",
256 ;; which finds the interpreter anywhere in $PATH.
259 (goto-char (point-min))
260 (if (looking-at howm-auto-mode-interpreter-regexp)
264 ;; Map interpreter name to a mode.
265 (setq elt (assoc (file-name-nondirectory interpreter)
266 interpreter-mode-alist))
268 (setq ans (cdr elt)))))))))
272 ;; copied from /usr/share/emacs/21.2/lisp/subr.el
273 ;; for emacs20 and xemacs
274 (when (not (fboundp 'replace-regexp-in-string))
275 (defun replace-regexp-in-string (regexp rep string &optional
276 fixedcase literal subexp start)
277 "Replace all matches for REGEXP with REP in STRING.
279 Return a new string containing the replacements.
281 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
282 arguments with the same names of function `replace-match'. If START
283 is non-nil, start replacements at that index in STRING.
285 REP is either a string used as the NEWTEXT arg of `replace-match' or a
286 function. If it is a function it is applied to each match to generate
287 the replacement passed to `replace-match'; the match-data at this
288 point are such that match 0 is the function's argument.
290 To replace only the first match (if any), make REGEXP match up to \\'
291 and replace a sub-expression, e.g.
292 (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
296 ;; To avoid excessive consing from multiple matches in long strings,
297 ;; don't just call `replace-match' continually. Walk down the
298 ;; string looking for matches of REGEXP and building up a (reversed)
299 ;; list MATCHES. This comprises segments of STRING which weren't
300 ;; matched interspersed with replacements for segments that were.
301 ;; [For a `large' number of replacments it's more efficient to
302 ;; operate in a temporary buffer; we can't tell from the function's
303 ;; args whether to choose the buffer-based implementation, though it
304 ;; might be reasonable to do so for long enough STRING.]
305 (let ((l (length string))
309 (while (and (< start l) (string-match regexp string start))
310 (setq mb (match-beginning 0)
312 ;; If we matched the empty string, make sure we advance by one char
313 (when (= me mb) (setq me (min l (1+ mb))))
314 ;; Generate a replacement for the matched substring.
315 ;; Operate only on the substring to minimize string consing.
316 ;; Set up match data for the substring for replacement;
317 ;; presumably this is likely to be faster than munging the
318 ;; match data directly in Lisp.
319 (string-match regexp (setq str (substring string mb me)))
321 (cons (replace-match (if (stringp rep)
323 (funcall rep (match-string 0 str)))
324 fixedcase literal str subexp)
325 (cons (substring string start mb) ; unmatched prefix
328 ;; Reconstruct a string from the pieces.
329 (setq matches (cons (substring string start l) matches)) ; leftover
330 (apply #'concat (nreverse matches)))))
333 (howm-defvar-risky howm-kill-all-enable-force nil)
334 (defun howm-kill-all (&optional force-p)
335 "Kill all buffers which is howm-mode and unmodified."
337 (let ((anyway (and force-p howm-kill-all-enable-force)))
339 (yes-or-no-p "Discard all unsaved changes on howm-mode buffers? ")
340 (y-or-n-p "Kill all howm-mode buffers? "))
341 (when (eq major-mode 'howm-view-summary-mode)
342 (howm-view-restore-window-configuration))
344 (when (howm-buffer-p b)
347 (set-buffer-modified-p nil)) ;; dangerous!
348 (when (not (buffer-modified-p b))
353 (defun howm-toggle-buffer ()
356 (howm-switch-to-nonhowm-buffer)
357 (howm-switch-to-howm-buffer)))
358 (defun howm-switch-to-howm-buffer ()
360 (let ((b (howm-find-buffer #'howm-buffer-p)))
364 (defun howm-switch-to-nonhowm-buffer ()
366 (switch-to-buffer (or (howm-find-buffer #'(lambda (b)
367 (not (howm-buffer-p b))))
368 (error "No nonhowm buffer"))))
370 (defun howm-find-buffer (pred)
373 (cond ((howm-internal-buffer-p b) nil) ;; skip
374 ((funcall pred b) (throw :found b))
379 (defun howm-internal-buffer-p (buf)
380 (string= (substring (buffer-name buf) 0 1) " "))
382 (defun howm-buffer-p (&optional buf)
383 (let* ((indep-dirs (cons nil *howm-independent-directories*))
384 (keyword-bufs (mapcar
386 (let ((default-directory (or d default-directory)))
387 (howm-keyword-buffer)))
389 (with-current-buffer (or buf (current-buffer))
392 '(howm-view-summary-mode
393 howm-view-contents-mode))
394 (member buf keyword-bufs)))))
396 (defun howm-mode-add-font-lock ()
397 (cheat-font-lock-append-keywords (howm-mode-add-font-lock-internal)))
399 (defun howm-mode-add-font-lock-internal ()
401 `(,@howm-user-font-lock-keywords
402 (,howm-view-title-regexp
403 (0 howm-mode-title-face prepend))
404 (,howm-keyword-regexp
405 (,howm-keyword-regexp-hilit-pos howm-mode-keyword-face prepend))
407 (,howm-ref-regexp-hilit-pos howm-mode-ref-face prepend))
409 (,howm-wiki-regexp-pos howm-mode-wiki-face prepend))
412 ;;; unofficial. may be removed if no one needs them.
414 (defun howm-show-buffer-as-howm ()
416 (let* ((name (buffer-name))
418 (s (buffer-substring-no-properties (point-min) (point-max)))
419 (b (get-buffer-create (format "*howm[%s]*" name))))
421 (howm-rewrite-read-only-buffer
424 (howm-initialize-buffer))
426 (switch-to-buffer b)))
430 (defun howm-narrow-to-memo ()
432 (apply #'narrow-to-region (howm-view-paragraph-region t)))
434 (defun howm-toggle-narrow ()
438 (howm-narrow-to-memo)))
440 (put 'howm-narrow-to-memo 'disabled t)
441 (put 'howm-toggle-narrow 'disabled t)
443 (defun howm-narrow-p ()
444 (let ((b (point-min))
448 (not (and (equal b (point-min))
449 (equal e (point-max)))))))
451 (defun howm-auto-narrow ()
452 (when (cond (*howm-view-item-privilege* nil)
453 ((eq howm-auto-narrow t) t)
454 (t (member (howm-command) howm-auto-narrow)))
455 (howm-narrow-to-memo)))
456 ;; (when (and (member (howm-command) howm-auto-narrow)
457 ;; (not *howm-view-item-privilege*))
459 ;;; select file for new memo by hand
461 (defun howm-create-interactively (&optional use-current-directory)
463 (find-file (read-file-name "Memo file: "
464 (if use-current-directory
467 (goto-char (point-max))
470 ;;; next/previous memo
472 (defmacro howm-save-narrowing (&rest body)
474 `(let ((narrowp (howm-narrow-p)))
481 (howm-narrow-to-memo)))))
483 (defun howm-next-memo (n)
486 (when (looking-at howm-view-title-regexp)
488 (re-search-forward howm-view-title-regexp nil nil n)))
490 (defun howm-previous-memo (n)
493 (when (not (looking-at howm-view-title-regexp))
495 (re-search-backward howm-view-title-regexp nil nil n)))
497 (defun howm-first-memo ()
500 (goto-char (point-min))))
502 (defun howm-last-memo ()
505 (goto-char (point-max)))
506 (re-search-backward howm-view-title-regexp))
510 (defvar howm-random-walk-buf nil "for internal use")
511 (defvar howm-random-walk-ro t "for internal use")
513 (defun howm-random-walk ()
515 (let ((orig-bufs (buffer-list))
516 (howm-history-file nil))
517 (while (let ((v (frame-visible-p (selected-frame))))
518 (and v (not (eq v 'icon))
519 (not (input-pending-p))))
521 (cond ((eq major-mode 'howm-view-summary-mode)
522 (howm-random-walk-summary))
524 (howm-random-walk-text))
527 (howm-random-walk-summary)))
529 (when (and (not (member b orig-bufs))
530 (null (get-buffer-window b)))
533 (sit-for howm-random-walk-wait))))
535 (defun howm-random-walk-summary ()
536 (let ((n (length (riffle-item-list))))
537 (goto-char (point-min))
538 (forward-line (random n))
539 (howm-view-summary-check)
540 (sit-for howm-random-walk-wait)
541 (howm-view-summary-open)))
543 (defun howm-random-walk-text ()
544 (let* ((ks (howm-keyword-for-goto))
545 (k (nth (random (length ks)) ks))
546 (d (- (point-max) (point-min))))
547 (goto-char (+ (point-min) (random d)))
548 (if (search-forward k nil t)
549 (goto-char (match-beginning 0))
550 (search-backward k nil t))
551 (sit-for howm-random-walk-wait)
552 (howm-keyword-search k)))
556 (defun howm-open-named-file ()
557 "Ask a file name and open it as howm note if it is under howm directory."
559 (let* ((item-dir (lambda (item) (file-name-directory (howm-item-name item))))
560 (dir (cond ((eq major-mode 'howm-view-summary-mode)
561 (funcall item-dir (howm-view-summary-current-item)))
562 ((eq major-mode 'howm-view-contents-mode)
563 (funcall item-dir (howm-view-contents-current-item)))
566 (fname (read-file-name "Howm file name: " dir)))
568 (if (file-exists-p fname)
571 (howm-insert-template "")
572 (howm-create-finish)))))
574 ;; imitation of remember.el
575 ;; http://www.emacswiki.org/cgi-bin/emacs-en/RememberMode
577 ;; shamelessly copied from http://newartisans.com/johnw/Emacs/remember.el
578 ;; (I cannot browse http://sacha.free.net.ph/notebook/emacs/dev today.)
580 (defvar howm-remember-wconf nil
582 (defvar howm-remember-buffer-name "*howm-remember*")
583 (defvar howm-remember-mode-hook nil)
584 (let ((m (make-sparse-keymap)))
585 (define-key m "\C-c\C-c" 'howm-remember-submit)
586 (define-key m "\C-c\C-k" 'howm-remember-discard)
587 (howm-defvar-risky howm-remember-mode-map m))
589 (defun howm-remember ()
590 "Add text to new note in howm."
592 (setq howm-remember-wconf (current-window-configuration))
593 (switch-to-buffer-other-window (get-buffer-create howm-remember-buffer-name))
596 `("Remember (%s) or discard (%s)."
597 ,@(mapcar (lambda (f)
599 (where-is-internal f howm-remember-mode-map t)))
600 '(howm-remember-submit howm-remember-discard)))))
602 (defun howm-remember-mode ()
603 "Major mode for `howm-remember'.
605 \\{howm-remember-mode-map}"
607 (kill-all-local-variables)
609 (use-local-map howm-remember-mode-map)
610 (setq major-mode 'howm-remember-mode
611 mode-name "HowmRemember")
612 (run-hooks 'howm-remember-mode-hook))
614 (defun howm-remember-submit ()
617 (let* ((title (howm-remember-get-title)) ;; has side effect
618 (s (buffer-substring-no-properties (point-min) (point-max))))
619 (set-window-configuration howm-remember-wconf)
620 (howm-create-file-with-title title)
623 (kill-buffer (current-buffer))))
624 (howm-remember-discard))
626 (defun howm-remember-get-title ()
627 (if (not howm-remember-first-line-to-title)
630 (goto-char (point-min))
632 (buffer-substring-no-properties (point-min)
635 (delete-region (point-min) (point))))))
637 (defun howm-remember-discard ()
639 (kill-buffer (current-buffer))
640 (set-window-configuration howm-remember-wconf))
644 ;; You can rename howm buffers based on their titles.
645 ;; Only buffer names in emacs are changed; file names are kept unchanged.
647 ;; Add the next lines to your .emacs if you like this feature.
648 ;; (add-hook 'howm-mode-hook 'howm-mode-set-buffer-name)
649 ;; (add-hook 'after-save-hook 'howm-mode-set-buffer-name)
651 ;; The original idea and code are given by Mielke-san (peter at exegenix.com).
652 ;; http://lists.sourceforge.jp/mailman/archives/howm-eng/2006/000020.html
655 (defvar howm-buffer-name-limit 20)
656 (defvar howm-buffer-name-total-limit howm-buffer-name-limit)
657 (defvar howm-buffer-name-format "%s"
658 "Buffer name format for `howm-mode-set-buffer-name'.
659 For example, buffer name is _ABC_ if title is ABC and the value of
660 this variable is \"_%s_\".")
662 (defun howm-truncate-string (string limit &optional dots-str)
663 "Truncate STRING if it is longer than LIMIT.
664 For example, \"1234567...\" is returned if string is \"123456789012\"
666 When DOTS-STR is non-nil, it is used instead of \"...\"."
667 (let ((dots (or dots-str "...")))
668 (when (> (length dots) limit)
669 (setq dots (substring dots 0 limit)))
670 (if (> (length string) limit)
671 (concat (substring string 0 (- limit (length dots)))
675 (defun howm-set-buffer-name-from-title (checker title-regexp title-regexp-pos)
676 "Set the buffer name to the title(s) of the file."
677 (when (funcall checker)
681 (while (re-search-forward title-regexp nil t)
683 (cons (match-string-no-properties title-regexp-pos)
685 (let ((name0 (mapconcat
687 (howm-truncate-string s howm-buffer-name-limit))
688 (reverse (cl-remove-if (lambda (s) (string= s ""))
691 (when (not (string= name0 "")) ;; exclude "no title" case
692 (let ((name (format howm-buffer-name-format
693 (howm-truncate-string
695 howm-buffer-name-total-limit))))
696 (rename-buffer name t))))))))
698 (defun howm-mode-set-buffer-name ()
699 (howm-set-buffer-name-from-title (lambda ()
700 (and howm-mode (buffer-file-name)))
701 howm-view-title-regexp
702 howm-view-title-regexp-pos))
704 ;; memoize: used in howm-bayesian-set
706 (defun howm-memoize-put (fname value)
707 (put fname 'howm-memoize value))
708 (defun howm-memoize-get (fname)
709 (get fname 'howm-memoize))
711 (defun howm-memoize-call (fname func args)
712 (let* ((p (assoc args (howm-memoize-get fname))))
715 ;; (message "hit %s" p)
717 (let ((r (apply func args)))
718 ;; We need to get it again because func can change memory.
719 (howm-memoize-put fname `((,args . ,r) ,@(howm-memoize-get fname)))
722 (defun howm-memoize-reset (fname)
723 (howm-memoize-put fname nil))
725 (defmacro howm-defun-memoize (fname args &rest body)
728 (howm-memoize-reset ',fname)
730 "Function generated by `howm-defun-memoize'"
731 (howm-memoize-call ',fname (lambda ,args ,@body) (list ,@args)))))
734 ;; (howm-memoize-reset 'fib)
735 ;; (howm-defun-memoize fib (n) (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))
737 ;; (howm-memoize-get 'fib)
741 ;; "M-x howm-bayesian-set RET lisp scheme haskell RET" to estimate
742 ;; related keywords with lisp, scheme, and haskell.
743 ;; If you are lucky, you may find ruby, elisp, gauche, etc.
744 ;; in estimated candidates.
747 ;; Zoubin Ghahramani and Katherine Heller: "Bayesian Sets",
748 ;; Advances in Neural Information Processing Systems,
749 ;; Vol. 18, pp. 435-442, MIT Press, 2006.
750 ;; http://books.nips.cc/nips18.html
751 ;; http://books.nips.cc/papers/files/nips18/NIPS2005_0712.pdf
753 (defun howm-bset-nodup (f &rest args)
754 (cl-remove-duplicates (apply f args) :test #'equal))
755 (defun howm-bset-mapcar (func lis)
756 (howm-bset-nodup #'mapcar func lis))
757 (defun howm-bset-mapcan (func lis)
758 (howm-bset-nodup (lambda (f z) (apply #'append (mapcar f z)))
761 (defun howm-bset-message (&rest args)
762 (let (message-log-max) ;; prevent it from being logged
763 (apply #'message args)))
765 (defun howm-bset-matched-files (query)
766 ;; (howm-bset-message "Finding files for query (%s)..." query)
767 (howm-bset-mapcar #'howm-item-name
768 (howm-view-search-folder-items query (howm-folder)
771 (howm-defun-memoize howm-bset-keywords-in-file* (file keyword-list)
772 ;; (howm-bset-message "Finding keywords in file (%s)..." file)
774 (insert-file-contents file)
775 (howm-keyword-for-goto keyword-list)))
777 (defun howm-bset-keywords-in-file (file)
778 (howm-bset-keywords-in-file* file nil))
780 (defun howm-bset-candidate-keywords (query-list)
781 ;; (howm-bset-message "Collecting keywords...")
782 (let ((files (howm-bset-mapcan #'howm-bset-matched-files
784 (howm-bset-mapcan (lambda (f)
785 (howm-bset-message "Collecting keywords in file (%s)..."
787 (howm-bset-keywords-in-file f))
790 (howm-defun-memoize howm-bset-file-score (file query-list
791 coef number-of-all-keywords)
792 ;; (howm-bset-message "Scoring file (%s)..." file)
793 (let* ((m (/ (length (howm-bset-keywords-in-file file))
794 (float number-of-all-keywords)))
797 (s (length (howm-bset-keywords-in-file* file query-list)))
799 (b2 (+ b (- (length query-list) s))))
800 ;; log{(a2/a) * (b/b2)}
801 (- (- (log a2) (log a)) (- (log b2) (log b)))))
803 (howm-defun-memoize howm-bset-keyword-score (keyword query-list
805 number-of-all-keywords)
806 (howm-bset-message "Scoring keyword (%s)..." keyword)
808 (mapcar (lambda (file)
809 (howm-bset-file-score file query-list coef
810 number-of-all-keywords))
811 (howm-bset-matched-files keyword))))
813 (defun howm-bset-reset ()
814 (mapc #'howm-memoize-reset '(howm-bset-file-score
815 howm-bset-keyword-score
816 howm-bset-keywords-in-file*)))
818 (defun howm-bset (query-list)
821 (let ((n (length (howm-keyword-list)))
822 (c 2.0)) ;; heuristic value
823 (sort (copy-sequence (howm-bset-candidate-keywords query-list))
827 (howm-bset-keyword-score k query-list c n))
831 (defun howm-bayesian-set (query-str)
832 (interactive "sQueries: ")
833 (switch-to-buffer (get-buffer-create "*howm-bayesian-set*"))
834 (howm-rewrite-read-only-buffer
835 (insert (mapconcat #'identity
836 (howm-bset (split-string query-str))
839 (goto-char (point-min))
840 (howm-bset-message "Done."))
842 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
845 ;; xemacs: add-to-list doesn't have APPEND
846 ;; (add-to-list 'auto-mode-alist '("\\.howm$" . text-mode) t)
847 (setq auto-mode-alist (append auto-mode-alist
848 (list '("\\.howm$" . text-mode))))
850 ;; xyzzy doesn't have eval-after-load.
851 ;; It will be useless anyway.
852 (when (not (fboundp 'eval-after-load))
853 (defun eval-after-load (file form)
856 ;; xemacs canna doesn't use minor-mode. [2004-01-30]
857 (defvar action-lock-mode-before-canna nil)
858 (make-variable-buffer-local 'action-lock-mode-before-canna)
859 (defadvice canna:enter-canna-mode (around action-lock-fix activate)
860 (setq action-lock-mode-before-canna action-lock-mode)
861 (setq action-lock-mode nil)
863 (defadvice canna:quit-canna-mode (around action-lock-fix activate)
864 (setq action-lock-mode action-lock-mode-before-canna)
867 ;; for mcomplete.el [2003-12-17]
868 ;; http://homepage1.nifty.com/bmonkey/emacs/elisp/mcomplete.el
869 ;; error when this-command is (lambda () (interactive) ...)
870 (defadvice mcomplete-p (around symbol-check activate)
871 (and (symbolp this-command)
874 ;; for auto-save-buffers.el [2004-01-10]
875 ;; http://www.namazu.org/~satoru/auto-save/
876 ;; http://homepage3.nifty.com/oatu/emacs/misc.html
877 ;; http://www.bookshelf.jp/cgi-bin/goto.cgi?file=meadow&node=auto%20save
878 (defvar howm-auto-save-buffers-disposed nil)
879 (howm-dont-warn-free-variable auto-save-buffers-regexp)
880 (howm-dont-warn-free-variable auto-save-reject-buffers-regexp)
881 (defun howm-auto-save-buffers-p ()
882 (let ((f (howm-file-name)))
883 (and (if (boundp 'auto-save-buffers-regexp)
884 (string-match auto-save-buffers-regexp f)
886 (if (boundp 'auto-save-reject-buffers-regexp)
887 (not (string-match auto-save-reject-buffers-regexp f))
889 (defun howm-auto-save-buffers-dispose ()
890 (setq howm-menu-refresh-after-save nil)
891 (setq howm-refresh-after-save nil)
892 (setq howm-auto-save-buffers-disposed t)
893 (message "howm: Automatic refresh is disabled when auto-save-buffers is called."))
894 (defadvice auto-save-buffers (around howm-dispose activate)
895 (if (or howm-auto-save-buffers-disposed
896 (not (howm-auto-save-buffers-p)))
898 (howm-auto-save-buffers-dispose)))
900 ;; howm on ChangeLog Memo
901 (defun howm-setup-change-log ()
902 (setq howm-keyword-format "\t* %s")
903 (setq howm-keyword-regexp "^\t\\(\\*\\)[ \t]+\\([^:\r\n]+\\)")
904 (setq howm-keyword-regexp-hilit-pos 1) ;; ¡Ö´ØÏ¢¥¡¼¥ï¡¼¥É¡×ÍÑ
905 (setq howm-keyword-regexp-pos 2)
906 (setq howm-view-title-regexp "^$")
907 (setq howm-view-title-regexp-pos 0)
908 (setq howm-view-title-regexp-grep 'sorry-not-yet)
909 (setq howm-use-color nil)
910 (setq howm-menu-top nil)
911 (defadvice howm-exclude-p (around change-log (filename) activate)
912 (setq ad-return-value
913 (not (find-if (lambda (dir)
914 (string= (howm-file-name)
915 (file-relative-name filename dir)))
916 (howm-search-path)))))
917 (defadvice howm-create-file-with-title (around change-log (title) activate)
919 (when (string-match howm-keyword-regexp title)
920 (setq title (match-string-no-properties howm-keyword-regexp-pos
923 (defadvice howm-create-file (around change-log
924 (&optional keep-cursor-p) activate)
925 (let* ((default (howm-file-name))
926 (file (expand-file-name default howm-directory))
927 (dir (file-name-directory file))
928 (buffer-file-name file)) ;; don't insert file name
929 (make-directory dir t)
930 (add-change-log-entry nil file)))
931 (add-hook 'change-log-mode-hook 'howm-mode)
934 ;; howm with ChangeLog Memo
935 (defvar howm-change-log-file-name "ChangeLog")
936 (defun howm-to-change-log ()
938 (let* ((title (howm-title-at-current-point))
939 (file (expand-file-name howm-change-log-file-name howm-directory))
940 ;; cheat add-change-log-entry
941 (buffer-file-name title)
942 (default-directory howm-directory))
943 (add-change-log-entry nil file)))
944 (defun howm-from-change-log ()
946 (let* ((title-regexp "^\t[*][ \t]*\\(.*\\)$")
948 (title (howm-title-at-current-point nil
949 title-regexp title-regexp-pos)))
950 (howm-create-file-with-title title)))
952 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
955 ;; Japanese is assumed at now.
958 "Show bug report template for howm."
962 (defun howm-set-lang ()
963 (set-language-environment "Japanese")
964 (set-default-coding-systems 'euc-jp)
965 (set-buffer-file-coding-system 'euc-jp-unix)
966 (set-terminal-coding-system 'euc-jp)
967 (set-keyboard-coding-system 'euc-jp)
970 (defun howm-compiled-p ()
971 (byte-code-function-p (symbol-function 'howm-compiled-p)))
972 (defun howm-make-file-p ()
974 (getenv "HOWM_MAKE")))
975 (defun howm-test-p ()
976 (getenv "HOWM_TEST"))
978 (defun howm-bug-report (&optional show-sym)
980 (let ((report-buf (format-time-string "howm-bug-report-%Y%m%d-%H%M%S"))
981 (template "sample/bug-report.txt"))
982 (switch-to-buffer report-buf)
983 (when (not (howm-buffer-empty-p))
984 (error "Buffer %s exists (and not empty)." report-buf))
985 (if (file-exists-p template)
986 (insert-file-contents template)
987 (insert "Please copy the following text to your bug report.\n\n"))
988 (goto-char (point-max))
990 (insert (format "%s: %s\n" (car sv) (cdr sv))))
992 ("howm" . ,(howm-version-long))
993 ,@(honest-report-version-assoc)
995 (when (eq howm-view-use-grep t)
997 (format "grep: %s - %s\n"
998 (cl-mapcan (lambda (d)
999 (let ((f (expand-file-name
1000 howm-view-grep-command d)))
1001 (and (file-executable-p f)
1004 (car (howm-call-process "grep" '("--version"))))))
1006 (goto-char (point-max))
1007 (insert "\n(List of variables)\n")
1008 (insert (howm-symbols-desc)))
1009 (goto-char (point-min))))
1011 (defun howm-version-long ()
1012 (format "%s (compile: %s, make: %s, test: %s)"
1018 (defun howm-symbols-desc (&optional max-desc-len)
1019 (when (null max-desc-len)
1020 (setq max-desc-len 50))
1022 (mapcar (lambda (sym)
1024 (let ((v (format "%S" (symbol-value sym))))
1025 (when (and (numberp max-desc-len)
1026 (< max-desc-len (length v)))
1028 (let* ((tl (/ max-desc-len 4))
1029 (hd (- max-desc-len tl)))
1030 (concat (substring v 0 hd)
1032 (substring v (- tl))))))
1033 (format "%s: %s\n" (symbol-name sym) v))))
1034 (sort (howm-symbols)
1036 (string< (symbol-name x) (symbol-name y)))))))
1038 (defvar howm-required-features '(
1046 "List of features which are required for, and distributed with, howm itself.")
1048 (defun howm-prefix-names ()
1049 (mapcar #'symbol-name (cons 'howm howm-required-features)))
1051 (defun howm-symbols ()
1052 (let* ((reg (format "^%s" (regexp-opt (howm-prefix-names) t)))
1054 (mapatoms (lambda (s)
1055 (when (string-match reg (symbol-name s))
1056 (setq a (cons s a)))))
1061 (mapcar #'elp-instrument-package
1062 (howm-prefix-names)))
1064 (defvar howm-sample-directory (expand-file-name "sample/")
1066 (defun howm-bug-shot ()
1068 (let* ((version (concat "[howm] " (howm-version-long)))
1069 (init (and (howm-test-p)
1070 (let ((f (expand-file-name "dot.emacs"
1071 howm-sample-directory)))
1072 (and (file-readable-p f)
1074 (insert-file-contents f)
1075 (buffer-substring-no-properties (point-min)
1078 (concat version "\n\n[init]\n" init)
1080 (footer "--- your comment ---"))
1081 (honest-report header footer)
1082 (message "Please copy this buffer to your report.")))
1084 ;;; howm-misc.el ends here