OSDN Git Service

update autotools
[howm/howm.git] / howm-misc.el
1 ;;; howm-misc.el --- Wiki-like note-taking tool
2 ;;; Copyright (C) 2002, 2003, 2004, 2005-2018
3 ;;;   HIRAOKA Kazuyuki <khi@users.osdn.me>
4 ;;;
5 ;;; This program is free software; you can redistribute it and/or modify
6 ;;; it under the terms of the GNU General Public License as published by
7 ;;; the Free Software Foundation; either version 1, or (at your option)
8 ;;; any later version.
9 ;;;
10 ;;; This program is distributed in the hope that it will be useful,
11 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 ;;; GNU General Public License for more details.
14 ;;;
15 ;;; The GNU General Public License is available by anonymouse ftp from
16 ;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
17 ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
18 ;;; USA.
19 ;;;--------------------------------------------------------------------
20
21 (provide 'howm-misc)
22 (require 'howm)
23
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25 ;; Misc.
26
27 (defun howm-version ()
28   (interactive)
29   (message "howm-%s" howm-version))
30
31 (defun howm-keyword-file ()
32   ;; create .howm-keys
33   (when (not (file-exists-p howm-keyword-file))
34     (save-excursion
35       (find-file howm-keyword-file)
36       (when howm-menu-top
37         (goto-char (point-min))
38         (insert howm-menu-top "\n"))
39       (set-buffer-modified-p t)
40       (save-buffer)
41       (kill-buffer nil)
42       (message "Generating %s ..." howm-keyword-file)
43       (howm-keyword-add-items (howm-all-items))
44       (message "Done.")))
45   howm-keyword-file)
46
47 (add-hook 'howm-view-open-hook 'howm-set-mode)
48 (defun howm-set-mode ()
49   (when (howm-set-mode-p)
50     (howm-set-configuration-for-major-mode major-mode)
51     (howm-mode 1)))
52
53 (defun howm-set-mode-p (&optional buf)
54   (with-current-buffer (or buf (current-buffer))
55     (let ((hdir (car (howm-search-path))))
56       (and (buffer-file-name)
57            (howm-folder-territory-p hdir (buffer-file-name))))))
58
59 (defvar howm-configuration-for-major-mode nil)
60 ;; ;; sample
61 ;; (setq howm-configuration-for-major-mode
62 ;;   '(
63 ;;     ;; fix me
64 ;;     (emacs-lisp-mode
65 ;;      . (
66 ;;         (howm-keyword-format . "(def[a-z*]+ +%s[ \t\r\n]")
67 ;;         (howm-keyword-regexp-format . "%s")
68 ;;         (howm-keyword-regexp . "(\\(def[a-z]+\\) +'?\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)") ;; ' for (defalias 'xxx ...)
69 ;;         (howm-keyword-regexp-hilit-pos . 1)
70 ;;         (howm-keyword-regexp-pos . 2)
71 ;;         (howm-view-title-regexp . "^(.*$")
72 ;; ;;         (howm-view-title-regexp . "^[^; \t\r\n].*$")
73 ;;         (howm-view-title-regexp-pos . 0)
74 ;;         (howm-view-title-regexp-grep . "^[^; \t\r\n].*$")
75 ;;         (howm-mode-title-face . nil)
76 ;;         (howm-keyword-list-alias-sep . nil)
77 ;;         (howm-view-preview-narrow . nil)
78 ;;         ))
79 ;;     (scheme-mode
80 ;;      . (
81 ;;         (howm-keyword-format . "(def[a-z]+ +[(]?%s[) \t\r\n]")
82 ;;         (howm-keyword-regexp-format . "%s")
83 ;;         (howm-keyword-regexp . "(\\(def[a-z]+\\) +[(]?\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)")
84 ;;         (howm-keyword-regexp-hilit-pos . 1)
85 ;;         (howm-keyword-regexp-pos . 2)
86 ;;         (howm-view-title-regexp . "^[^; \t\r\n].*$")
87 ;;         (howm-view-title-regexp-pos . 0)
88 ;;         (howm-view-title-regexp-grep . "^[^; \t\r\n].*$")
89 ;;         (howm-mode-title-face . nil)
90 ;;         (howm-keyword-list-alias-sep . nil)
91 ;;         (howm-view-preview-narrow . nil)
92 ;;         ))
93 ;;     (ruby-mode
94 ;;      . (
95 ;;         (howm-keyword-format . "\\(def\\|class\\) +%s\\b")
96 ;;         (howm-keyword-regexp-format . "%s")
97 ;;         (howm-keyword-regexp . "\\(def\\|class\\) +\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)")
98 ;;         (howm-keyword-regexp-hilit-pos . 1)
99 ;;         (howm-keyword-regexp-pos . 2)
100 ;;         (howm-view-title-regexp . "^[^# \t\r\n].*$")
101 ;;         (howm-view-title-regexp-pos . 0)
102 ;;         (howm-view-title-regexp-grep . "^[^# \t\r\n].*$")
103 ;;         (howm-mode-title-face . nil)
104 ;;         (howm-keyword-list-alias-sep . nil)
105 ;;         (howm-view-preview-narrow . nil)
106 ;;         ))
107 ;;     (yatex-mode
108 ;;      . (
109 ;;         (howm-keyword-format . "\\\\label%s")
110 ;;         (howm-keyword-regexp-format . "%s")
111 ;;         (howm-keyword-regexp . "\\(\\\\label\\)\\({[^}\r\n]+}\\)")
112 ;;         (howm-keyword-regexp-hilit-pos . 1)
113 ;;         (howm-keyword-regexp-pos . 2)
114 ;;         (howm-view-title-regexp . "\\\\\\(\\(sub\\)*section\\|chapter\\|part\\|begin\\)")
115 ;;         (howm-view-title-regexp-pos . 0)
116 ;;         (howm-view-title-regexp-grep . "\\\\((sub)*section|chapter|part|begin)")
117 ;;         (howm-mode-title-face . nil)
118 ;;         (howm-keyword-list-alias-sep . nil)
119 ;;         (howm-view-preview-narrow . nil)
120 ;;         ))
121 ;;     ))
122
123 (defun howm-set-configuration-for-file-name (f)
124   (let ((mode (howm-auto-mode f)))
125     (howm-set-configuration-for-major-mode mode)))
126
127 (defun howm-set-configuration-for-major-mode (mode)
128   (let ((a (cdr (assoc mode howm-configuration-for-major-mode))))
129     (when a  ;; I know this is redundant.
130       (mapc (lambda (sv)
131               (let ((symbol (car sv))
132                     (value (cdr sv)))
133                 (set (make-local-variable symbol) value)))
134             a))))
135
136 (defmacro howm-if-unbound (var &rest alt-body)
137   `(if (boundp ',var) ,var ,@alt-body))
138
139 ;; copied and modified from set-auto-mode in /usr/share/emacs/21.2/lisp/files.el
140 ;; (I don't want to set the mode actually. Sigh...)
141 (howm-dont-warn-free-variable auto-mode-interpreter-regexp)
142 (defvar howm-auto-mode-interpreter-regexp
143   (howm-if-unbound auto-mode-interpreter-regexp
144                    ;; xemacs doesn't have it.
145                    "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)"))
146 (defun howm-auto-mode (&optional file-name)
147   "Major mode appropriate for current buffer.
148 This checks for a -*- mode tag in the buffer's text,
149 compares the filename against the entries in `auto-mode-alist',
150 or checks the interpreter that runs this file against
151 `interpreter-mode-alist'.
152
153 It does not check for the `mode:' local variable in the
154 Local Variables section of the file; for that, use `hack-local-variables'.
155
156 If `enable-local-variables' is nil, this function does not check for a
157 -*- mode tag.
158
159 This function merely returns the mode; it does not set the mode.
160 "
161   ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
162   (let (beg end done modes ans)
163     (save-excursion
164       (goto-char (point-min))
165       (skip-chars-forward " \t\n")
166       (and enable-local-variables
167            ;; Don't look for -*- if this file name matches any
168            ;; of the regexps in inhibit-first-line-modes-regexps.
169            (let ((temp (howm-if-unbound inhibit-first-line-modes-regexps
170                                         inhibit-local-variables-regexps))
171                  (name (file-name-sans-versions (or file-name ""))))
172              (while (let ((sufs (howm-if-unbound inhibit-first-line-modes-suffixes
173                                                  inhibit-local-variables-suffixes)))
174                       (while (and sufs (not (string-match (car sufs) name)))
175                         (setq sufs (cdr sufs)))
176                       sufs)
177                (setq name (substring name 0 (match-beginning 0))))
178              (while (and temp
179                          (not (string-match (car temp) name)))
180                (setq temp (cdr temp)))
181              (not temp))
182            (search-forward "-*-" (save-excursion
183                                    ;; If the file begins with "#!"
184                                    ;; (exec interpreter magic), look
185                                    ;; for mode frobs in the first two
186                                    ;; lines.  You cannot necessarily
187                                    ;; put them in the first line of
188                                    ;; such a file without screwing up
189                                    ;; the interpreter invocation.
190                                    (end-of-line (and (looking-at "^#!") 2))
191                                    (point)) t)
192            (progn
193              (skip-chars-forward " \t")
194              (setq beg (point))
195              (search-forward "-*-"
196                              (save-excursion (end-of-line) (point))
197                              t))
198            (progn
199              (forward-char -3)
200              (skip-chars-backward " \t")
201              (setq end (point))
202              (goto-char beg)
203              (if (save-excursion (search-forward ":" end t))
204                  ;; Find all specifications for the `mode:' variable
205                  ;; and execute them left to right.
206                  (while (let ((case-fold-search t))
207                           (or (and (looking-at "mode:")
208                                    (goto-char (match-end 0)))
209                               (re-search-forward "[ \t;]mode:" end t)))
210                    (skip-chars-forward " \t")
211                    (setq beg (point))
212                    (if (search-forward ";" end t)
213                        (forward-char -1)
214                      (goto-char end))
215                    (skip-chars-backward " \t")
216                    (push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
217                          modes))
218                ;; Simple -*-MODE-*- case.
219                (push (intern (concat (downcase (buffer-substring beg end))
220                                      "-mode"))
221                      modes)))))
222     ;; If we found modes to use, set done.
223     (dolist (mode (nreverse modes))
224       (when (functionp mode)
225         (setq ans mode)
226         (setq done t)))
227     ;; If we didn't find a mode from a -*- line, try using the file name.
228     (if (and (not done) file-name)
229         (let ((name file-name)
230               (keep-going t))
231           ;; Remove backup-suffixes from file name.
232           (setq name (file-name-sans-versions name))
233           (while keep-going
234             (setq keep-going nil)
235             (let ((alist auto-mode-alist)
236                   (mode nil))
237               ;; Find first matching alist entry.
238               (let ((case-fold-search
239                      (memq system-type '(vax-vms windows-nt))))
240                 (while (and (not mode) alist)
241                   (if (string-match (car (car alist)) name)
242                       (if (and (consp (cdr (car alist)))
243                                (nth 2 (car alist)))
244                           (setq mode (car (cdr (car alist)))
245                                 name (substring name 0 (match-beginning 0))
246                                 keep-going t)
247                         (setq mode (cdr (car alist))
248                               keep-going nil)))
249                   (setq alist (cdr alist))))
250               (if mode
251                   (setq ans mode)
252                 ;; If we can't deduce a mode from the file name,
253                 ;; look for an interpreter specified in the first line.
254                 ;; As a special case, allow for things like "#!/bin/env perl",
255                 ;; which finds the interpreter anywhere in $PATH.
256                 (let ((interpreter
257                        (save-excursion
258                          (goto-char (point-min))
259                          (if (looking-at howm-auto-mode-interpreter-regexp)
260                              (match-string 2)
261                            "")))
262                       elt)
263                   ;; Map interpreter name to a mode.
264                   (setq elt (assoc (file-name-nondirectory interpreter)
265                                    interpreter-mode-alist))
266                   (if elt
267                       (setq ans (cdr elt)))))))))
268     ans
269     ))
270
271 ;; copied from /usr/share/emacs/21.2/lisp/subr.el
272 ;; for emacs20 and xemacs
273 (when (not (fboundp 'replace-regexp-in-string))
274   (defun replace-regexp-in-string (regexp rep string &optional
275                                           fixedcase literal subexp start)
276     "Replace all matches for REGEXP with REP in STRING.
277
278 Return a new string containing the replacements.
279
280 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
281 arguments with the same names of function `replace-match'.  If START
282 is non-nil, start replacements at that index in STRING.
283
284 REP is either a string used as the NEWTEXT arg of `replace-match' or a
285 function.  If it is a function it is applied to each match to generate
286 the replacement passed to `replace-match'; the match-data at this
287 point are such that match 0 is the function's argument.
288
289 To replace only the first match (if any), make REGEXP match up to \\'
290 and replace a sub-expression, e.g.
291   (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
292     => \" bar foo\"
293 "
294
295     ;; To avoid excessive consing from multiple matches in long strings,
296     ;; don't just call `replace-match' continually.  Walk down the
297     ;; string looking for matches of REGEXP and building up a (reversed)
298     ;; list MATCHES.  This comprises segments of STRING which weren't
299     ;; matched interspersed with replacements for segments that were.
300     ;; [For a `large' number of replacments it's more efficient to
301     ;; operate in a temporary buffer; we can't tell from the function's
302     ;; args whether to choose the buffer-based implementation, though it
303     ;; might be reasonable to do so for long enough STRING.]
304     (let ((l (length string))
305           (start (or start 0))
306           matches str mb me)
307       (save-match-data
308         (while (and (< start l) (string-match regexp string start))
309           (setq mb (match-beginning 0)
310                 me (match-end 0))
311           ;; If we matched the empty string, make sure we advance by one char
312           (when (= me mb) (setq me (min l (1+ mb))))
313           ;; Generate a replacement for the matched substring.
314           ;; Operate only on the substring to minimize string consing.
315           ;; Set up match data for the substring for replacement;
316           ;; presumably this is likely to be faster than munging the
317           ;; match data directly in Lisp.
318           (string-match regexp (setq str (substring string mb me)))
319           (setq matches
320                 (cons (replace-match (if (stringp rep)
321                                          rep
322                                        (funcall rep (match-string 0 str)))
323                                      fixedcase literal str subexp)
324                       (cons (substring string start mb) ; unmatched prefix
325                             matches)))
326           (setq start me))
327         ;; Reconstruct a string from the pieces.
328         (setq matches (cons (substring string start l) matches)) ; leftover
329         (apply #'concat (nreverse matches)))))
330   )
331
332 (howm-defvar-risky howm-kill-all-enable-force nil)
333 (defun howm-kill-all (&optional force-p)
334   "Kill all buffers which is howm-mode and unmodified."
335   (interactive "P")
336   (let ((anyway (and force-p howm-kill-all-enable-force)))
337     (when (if anyway
338               (yes-or-no-p "Discard all unsaved changes on howm-mode buffers? ")
339             (y-or-n-p "Kill all howm-mode buffers? "))
340       (when (eq major-mode 'howm-view-summary-mode)
341         (howm-view-restore-window-configuration))
342       (mapc (lambda (b)
343               (when (howm-buffer-p b)
344                 (when anyway
345                   (switch-to-buffer b)
346                   (set-buffer-modified-p nil))  ;; dangerous!
347                 (when (not (buffer-modified-p b))
348                   (kill-buffer b))))
349             (buffer-list))
350       (message "Done."))))
351
352 (defun howm-toggle-buffer ()
353   (interactive)
354   (if (howm-buffer-p)
355       (howm-switch-to-nonhowm-buffer)
356     (howm-switch-to-howm-buffer)))
357 (defun howm-switch-to-howm-buffer ()
358   (interactive)
359   (let ((b (howm-find-buffer #'howm-buffer-p)))
360     (if b
361         (switch-to-buffer b)
362       (howm-menu))))
363 (defun howm-switch-to-nonhowm-buffer ()
364   (interactive)
365   (switch-to-buffer (or (howm-find-buffer #'(lambda (b)
366                                               (not (howm-buffer-p b))))
367                         (error "No nonhowm buffer"))))
368
369 (defun howm-find-buffer (pred)
370   (catch :found
371     (mapc (lambda (b)
372             (cond ((howm-internal-buffer-p b) nil) ;; skip
373                   ((funcall pred b) (throw :found b))
374                   (t t)))
375           (buffer-list))
376     nil))
377
378 (defun howm-internal-buffer-p (buf)
379   (string= (substring (buffer-name buf) 0 1) " "))
380
381 (defun howm-buffer-p (&optional buf)
382   (let* ((indep-dirs (cons nil *howm-independent-directories*))
383          (keyword-bufs (mapcar
384                         (lambda (d)
385                           (let ((default-directory (or d default-directory)))
386                             (howm-keyword-buffer)))
387                         indep-dirs)))
388     (with-current-buffer (or buf (current-buffer))
389       (or howm-mode
390           (member major-mode
391                   '(howm-view-summary-mode
392                     howm-view-contents-mode))
393           (member buf keyword-bufs)))))
394
395 (defun howm-mode-add-font-lock ()
396   (cheat-font-lock-append-keywords (howm-mode-add-font-lock-internal)))
397
398 (defun howm-mode-add-font-lock-internal ()
399   (when howm-use-color
400     `(,@howm-user-font-lock-keywords
401       (,howm-view-title-regexp
402        (0 howm-mode-title-face prepend))
403       (,howm-keyword-regexp
404        (,howm-keyword-regexp-hilit-pos howm-mode-keyword-face prepend))
405       (,howm-ref-regexp
406        (,howm-ref-regexp-hilit-pos howm-mode-ref-face prepend))
407       (,howm-wiki-regexp
408        (,howm-wiki-regexp-pos howm-mode-wiki-face prepend))
409       )))
410
411 ;;; unofficial. may be removed if no one needs them.
412
413 (defun howm-show-buffer-as-howm ()
414   (interactive)
415   (let* ((name (buffer-name))
416          (pos (point))
417          (s (buffer-substring-no-properties (point-min) (point-max)))
418          (b (get-buffer-create (format "*howm[%s]*" name))))
419     (set-buffer b)
420     (howm-rewrite-read-only-buffer
421       (insert s)
422       (howm-mode 1)
423       (howm-initialize-buffer))
424     (goto-char pos)
425     (switch-to-buffer b)))
426
427 ;;; narrowing
428
429 (defun howm-narrow-to-memo ()
430   (interactive)
431   (apply #'narrow-to-region (howm-view-paragraph-region t)))
432
433 (defun howm-toggle-narrow ()
434   (interactive)
435   (if (howm-narrow-p)
436       (widen)
437     (howm-narrow-to-memo)))
438
439 (put 'howm-narrow-to-memo 'disabled t)
440 (put 'howm-toggle-narrow 'disabled t)
441
442 (defun howm-narrow-p ()
443   (let ((b (point-min))
444         (e (point-max)))
445     (save-restriction
446       (widen)
447       (not (and (equal b (point-min))
448                 (equal e (point-max)))))))
449
450 (defun howm-auto-narrow ()
451   (when (cond (*howm-view-item-privilege* nil)
452               ((eq howm-auto-narrow t) t)
453               (t (member (howm-command) howm-auto-narrow)))
454     (howm-narrow-to-memo)))
455 ;;   (when (and (member (howm-command) howm-auto-narrow)
456 ;;              (not *howm-view-item-privilege*))
457
458 ;;; select file for new memo by hand
459
460 (defun howm-create-interactively (&optional use-current-directory)
461   (interactive "P")
462   (find-file (read-file-name "Memo file: "
463                              (if use-current-directory
464                                  nil
465                                howm-directory)))
466   (goto-char (point-max))
467   (howm-create-here))
468
469 ;;; next/previous memo
470
471 (defmacro howm-save-narrowing (&rest body)
472   (declare (indent 0))
473   `(let ((narrowp (howm-narrow-p)))
474      (when narrowp
475        (widen))
476      (unwind-protect
477          (progn
478            ,@body)
479        (when narrowp
480          (howm-narrow-to-memo)))))
481
482 (defun howm-next-memo (n)
483   (interactive "p")
484   (howm-save-narrowing
485     (when (looking-at howm-view-title-regexp)
486       (setq n (+ n 1)))
487     (re-search-forward howm-view-title-regexp nil nil n)))
488
489 (defun howm-previous-memo (n)
490   (interactive "p")
491   (howm-save-narrowing
492     (when (not (looking-at howm-view-title-regexp))
493       (setq n (+ n 1)))
494     (re-search-backward howm-view-title-regexp nil nil n)))
495
496 (defun howm-first-memo ()
497   (interactive)
498   (howm-save-narrowing
499     (goto-char (point-min))))
500
501 (defun howm-last-memo ()
502   (interactive)
503   (howm-save-narrowing
504     (goto-char (point-max)))
505   (re-search-backward howm-view-title-regexp))
506
507 ;;; random walk
508
509 (defvar howm-random-walk-buf nil "for internal use")
510 (defvar howm-random-walk-ro t "for internal use")
511
512 (defun howm-random-walk ()
513   (interactive)
514   (let ((orig-bufs (buffer-list))
515         (howm-history-file nil))
516     (while (let ((v (frame-visible-p (selected-frame))))
517              (and v (not (eq v 'icon))
518                   (not (input-pending-p))))
519       (unwind-protect
520           (cond ((eq major-mode 'howm-view-summary-mode)
521                  (howm-random-walk-summary))
522                 (howm-mode
523                  (howm-random-walk-text))
524                 (t
525                  (howm-list-all)
526                  (howm-random-walk-summary)))
527         (mapc (lambda (b)
528                 (when (and (not (member b orig-bufs))
529                            (null (get-buffer-window b)))
530                   (kill-buffer b)))
531               (buffer-list)))
532       (sit-for howm-random-walk-wait))))
533
534 (defun howm-random-walk-summary ()
535   (let ((n (length (riffle-item-list))))
536     (goto-char (point-min))
537     (forward-line (random n))
538     (howm-view-summary-check)
539     (sit-for howm-random-walk-wait)
540     (howm-view-summary-open)))
541
542 (defun howm-random-walk-text ()
543   (let* ((ks (howm-keyword-for-goto))
544          (k (nth (random (length ks)) ks))
545          (d (- (point-max) (point-min))))
546     (goto-char (+ (point-min) (random d)))
547     (if (search-forward k nil t)
548         (goto-char (match-beginning 0))
549       (search-backward k nil t))
550     (sit-for howm-random-walk-wait)
551     (howm-keyword-search k)))
552
553 ;; named note
554
555 (defun howm-open-named-file ()
556   "Ask a file name and open it as howm note if it is under howm directory."
557   (interactive)
558   (let* ((item-dir (lambda (item) (file-name-directory (howm-item-name item))))
559          (dir (cond ((eq major-mode 'howm-view-summary-mode)
560                      (funcall item-dir (howm-view-summary-current-item)))
561                     ((eq major-mode 'howm-view-contents-mode)
562                      (funcall item-dir (howm-view-contents-current-item)))
563                     (t
564                      howm-directory)))
565          (fname (read-file-name "Howm file name: " dir)))
566     (find-file fname)
567     (if (file-exists-p fname)
568         (howm-set-mode)
569       (progn
570         (howm-insert-template "")
571         (howm-create-finish)))))
572
573 ;; imitation of remember.el
574 ;; http://www.emacswiki.org/cgi-bin/emacs-en/RememberMode
575
576 ;; shamelessly copied from http://newartisans.com/johnw/Emacs/remember.el
577 ;; (I cannot browse http://sacha.free.net.ph/notebook/emacs/dev today.)
578
579 (defvar howm-remember-wconf nil
580   "for internal use")
581 (defvar howm-remember-buffer-name "*howm-remember*")
582 (defvar howm-remember-mode-hook nil)
583 (let ((m (make-sparse-keymap)))
584   (define-key m "\C-c\C-c" 'howm-remember-submit)
585   (define-key m "\C-c\C-k" 'howm-remember-discard)
586   (howm-defvar-risky howm-remember-mode-map m))
587
588 (defun howm-remember ()
589   "Add text to new note in howm."
590   (interactive)
591   (setq howm-remember-wconf (current-window-configuration))
592   (switch-to-buffer-other-window (get-buffer-create howm-remember-buffer-name))
593   (howm-remember-mode)
594   (apply #'message
595          `("Remember (%s) or discard (%s)."
596            ,@(mapcar (lambda (f)
597                        (key-description
598                         (where-is-internal f howm-remember-mode-map t)))
599                      '(howm-remember-submit howm-remember-discard)))))
600
601 (defun howm-remember-mode ()
602   "Major mode for `howm-remember'.
603
604 \\{howm-remember-mode-map}"
605   (interactive)
606   (kill-all-local-variables)
607   (text-mode)
608   (use-local-map howm-remember-mode-map)
609   (setq major-mode 'howm-remember-mode
610         mode-name "HowmRemember")
611   (run-hooks 'howm-remember-mode-hook))
612
613 (defun howm-remember-submit ()
614   (interactive)
615   (save-excursion
616     (let* ((title (howm-remember-get-title)) ;; has side effect
617            (s (buffer-substring-no-properties (point-min) (point-max))))
618       (set-window-configuration howm-remember-wconf)
619       (howm-create-file-with-title title)
620       (insert s "\n")
621       (save-buffer)
622       (kill-buffer (current-buffer))))
623   (howm-remember-discard))
624
625 (defun howm-remember-get-title ()
626   (if (not howm-remember-first-line-to-title)
627       ""
628     (progn
629       (goto-char (point-min))
630       (prog1
631           (buffer-substring-no-properties (point-min)
632                                           (line-end-position))
633         (forward-line 1)
634         (delete-region (point-min) (point))))))
635
636 (defun howm-remember-discard ()
637   (interactive)
638   (kill-buffer (current-buffer))
639   (set-window-configuration howm-remember-wconf))
640
641 ;; Rename buffer
642 ;; 
643 ;; You can rename howm buffers based on their titles.
644 ;; Only buffer names in emacs are changed; file names are kept unchanged.
645 ;; 
646 ;; Add the next lines to your .emacs if you like this feature.
647 ;; (add-hook 'howm-mode-hook 'howm-mode-set-buffer-name)
648 ;; (add-hook 'after-save-hook 'howm-mode-set-buffer-name)
649 ;; 
650 ;; The original idea and code are given by Mielke-san (peter at exegenix.com).
651 ;; http://lists.sourceforge.jp/mailman/archives/howm-eng/2006/000020.html
652 ;; thx!
653
654 (defvar howm-buffer-name-limit 20)
655 (defvar howm-buffer-name-total-limit howm-buffer-name-limit)
656 (defvar howm-buffer-name-format "%s"
657   "Buffer name format for `howm-mode-set-buffer-name'.
658 For example, buffer name is _ABC_ if title is ABC and the value of
659 this variable is \"_%s_\".")
660
661 (defun howm-truncate-string (string limit &optional dots-str)
662   "Truncate STRING if it is longer than LIMIT.
663 For example, \"1234567...\" is returned if string is \"123456789012\"
664 and limit is 10.
665 When DOTS-STR is non-nil, it is used instead of \"...\"."
666   (let ((dots (or dots-str "...")))
667     (when (> (length dots) limit)
668       (setq dots (substring dots 0 limit)))
669     (if (> (length string) limit)
670         (concat (substring string 0 (- limit (length dots)))
671                 dots)
672       string)))
673
674 (defun howm-set-buffer-name-from-title (checker title-regexp title-regexp-pos)
675   "Set the buffer name to the title(s) of the file."
676   (when (funcall checker)
677     (save-excursion
678       (goto-char 0)
679       (let ((titles nil))
680         (while (re-search-forward title-regexp nil t)
681           (setq titles
682                 (cons (match-string-no-properties title-regexp-pos)
683                       titles))) 
684         (let ((name0 (mapconcat  
685                       (lambda (s)
686                         (howm-truncate-string s howm-buffer-name-limit))
687                       (reverse (cl-remove-if (lambda (s) (string= s ""))
688                                                   titles))
689                       "/")))
690           (when (not (string= name0 "")) ;; exclude "no title" case
691             (let ((name (format howm-buffer-name-format
692                                 (howm-truncate-string
693                                  name0
694                                  howm-buffer-name-total-limit))))
695               (rename-buffer name t))))))))
696
697 (defun howm-mode-set-buffer-name ()
698   (howm-set-buffer-name-from-title (lambda ()
699                                      (and howm-mode (buffer-file-name)))
700                                    howm-view-title-regexp
701                                    howm-view-title-regexp-pos))
702
703 ;; memoize: used in howm-bayesian-set
704
705 (defun howm-memoize-put (fname value)
706   (put fname 'howm-memoize value))
707 (defun howm-memoize-get (fname)
708   (get fname 'howm-memoize))
709
710 (defun howm-memoize-call (fname func args)
711   (let* ((p (assoc args (howm-memoize-get fname))))
712     (if p
713         (progn
714 ;;           (message "hit %s" p)
715           (cdr p))
716       (let ((r (apply func args)))
717         ;; We need to get it again because func can change memory.
718         (howm-memoize-put fname `((,args . ,r) ,@(howm-memoize-get fname)))
719         r))))
720
721 (defun howm-memoize-reset (fname)
722   (howm-memoize-put fname nil))
723
724 (defmacro howm-defun-memoize (fname args &rest body)
725   (declare (indent 2))
726   `(progn
727      (howm-memoize-reset ',fname)
728      (defun ,fname ,args
729        "Function generated by `howm-defun-memoize'"
730        (howm-memoize-call ',fname (lambda ,args ,@body) (list ,@args)))))
731
732 ;; ;; test
733 ;; (howm-memoize-reset 'fib)
734 ;; (howm-defun-memoize fib (n) (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))
735 ;; (fib 5)
736 ;; (howm-memoize-get 'fib)
737
738 ;; Bayesian set
739 ;; 
740 ;; "M-x howm-bayesian-set RET lisp scheme haskell RET" to estimate
741 ;; related keywords with lisp, scheme, and haskell.
742 ;; If you are lucky, you may find ruby, elisp, gauche, etc.
743 ;; in estimated candidates.
744 ;; 
745 ;; (ref.)
746 ;; Zoubin Ghahramani and Katherine Heller: "Bayesian Sets",
747 ;; Advances in Neural Information Processing Systems,
748 ;; Vol. 18, pp. 435-442, MIT Press, 2006.
749 ;; http://books.nips.cc/nips18.html
750 ;; http://books.nips.cc/papers/files/nips18/NIPS2005_0712.pdf
751
752 (defun howm-bset-nodup (f &rest args)
753   (cl-remove-duplicates (apply f args) :test #'equal))
754 (defun howm-bset-mapcar (func lis)
755   (howm-bset-nodup #'mapcar func lis))
756 (defun howm-bset-mapcan (func lis)
757   (howm-bset-nodup (lambda (f z) (apply #'append (mapcar f z)))
758                    func lis))
759
760 (defun howm-bset-message (&rest args)
761   (let (message-log-max) ;; prevent it from being logged
762     (apply #'message args)))
763
764 (defun howm-bset-matched-files (query)
765 ;;   (howm-bset-message "Finding files for query (%s)..." query)
766   (howm-bset-mapcar #'howm-item-name
767                     (howm-view-search-folder-items query (howm-folder)
768                                                    nil t)))
769
770 (howm-defun-memoize howm-bset-keywords-in-file* (file keyword-list)
771 ;;   (howm-bset-message "Finding keywords in file (%s)..." file)
772   (with-temp-buffer
773     (insert-file-contents file)
774     (howm-keyword-for-goto keyword-list)))
775
776 (defun howm-bset-keywords-in-file (file)
777   (howm-bset-keywords-in-file* file nil))
778
779 (defun howm-bset-candidate-keywords (query-list)
780 ;;   (howm-bset-message "Collecting keywords...")
781   (let ((files (howm-bset-mapcan #'howm-bset-matched-files
782                                  query-list)))
783     (howm-bset-mapcan (lambda (f)
784                         (howm-bset-message "Collecting keywords in file (%s)..."
785                                            f)
786                         (howm-bset-keywords-in-file f))
787                       files)))
788
789 (howm-defun-memoize howm-bset-file-score (file query-list
790                                                coef number-of-all-keywords)
791 ;;   (howm-bset-message "Scoring file (%s)..." file)
792   (let* ((m (/ (length (howm-bset-keywords-in-file file))
793                (float number-of-all-keywords)))
794          (a (* coef m))
795          (b (* coef (- 1 m)))
796          (s (length (howm-bset-keywords-in-file* file query-list)))
797          (a2 (+ a s))
798          (b2 (+ b (- (length query-list) s))))
799     ;; log{(a2/a) * (b/b2)}
800     (- (- (log a2) (log a)) (- (log b2) (log b)))))
801
802 (howm-defun-memoize howm-bset-keyword-score (keyword query-list
803                                                      coef
804                                                      number-of-all-keywords)
805   (howm-bset-message "Scoring keyword (%s)..." keyword)
806   (apply #'+
807          (mapcar (lambda (file)
808                    (howm-bset-file-score file query-list coef
809                                          number-of-all-keywords))
810                  (howm-bset-matched-files keyword))))
811
812 (defun howm-bset-reset ()
813   (mapc #'howm-memoize-reset '(howm-bset-file-score
814                                howm-bset-keyword-score
815                                howm-bset-keywords-in-file*)))
816
817 (defun howm-bset (query-list)
818   (howm-bset-reset)
819   (unwind-protect
820       (let ((n (length (howm-keyword-list)))
821             (c 2.0)) ;; heuristic value
822         (sort (copy-sequence (howm-bset-candidate-keywords query-list))
823               (lambda (k1 k2)
824                 (apply #'>
825                        (mapcar (lambda (k)
826                                  (howm-bset-keyword-score k query-list c n))
827                                (list k1 k2))))))
828     (howm-bset-reset)))
829
830 (defun howm-bayesian-set (query-str)
831   (interactive "sQueries: ")
832   (switch-to-buffer (get-buffer-create "*howm-bayesian-set*"))
833   (howm-rewrite-read-only-buffer
834     (insert (mapconcat #'identity
835                        (howm-bset (split-string query-str))
836                        "\n"))
837     (howm-mode 1))
838   (goto-char (point-min))
839   (howm-bset-message "Done."))
840
841 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
842 ;; Fellowship
843
844 ;; xemacs: add-to-list doesn't have APPEND
845 ;; (add-to-list 'auto-mode-alist '("\\.howm$" . text-mode) t)
846 (setq auto-mode-alist (append auto-mode-alist 
847                               (list '("\\.howm$" . text-mode))))
848
849 ;; xyzzy doesn't have eval-after-load.
850 ;; It will be useless anyway.
851 (when (not (fboundp 'eval-after-load))
852   (defun eval-after-load (file form)
853     nil))
854
855 ;; xemacs canna doesn't use minor-mode. [2004-01-30]
856 (defvar action-lock-mode-before-canna nil)
857 (make-variable-buffer-local 'action-lock-mode-before-canna)
858 (defadvice canna:enter-canna-mode (around action-lock-fix activate)
859   (setq action-lock-mode-before-canna action-lock-mode)
860   (setq action-lock-mode nil)
861   ad-do-it)
862 (defadvice canna:quit-canna-mode (around action-lock-fix activate)
863   (setq action-lock-mode action-lock-mode-before-canna)
864   ad-do-it)
865  
866 ;; for mcomplete.el [2003-12-17]
867 ;; http://homepage1.nifty.com/bmonkey/emacs/elisp/mcomplete.el
868 ;; error when this-command is (lambda () (interactive) ...)
869 (defadvice mcomplete-p (around symbol-check activate)
870   (and (symbolp this-command)
871        ad-do-it))
872
873 ;; for auto-save-buffers.el [2004-01-10]
874 ;; http://www.namazu.org/~satoru/auto-save/
875 ;; http://homepage3.nifty.com/oatu/emacs/misc.html
876 ;; http://www.bookshelf.jp/cgi-bin/goto.cgi?file=meadow&node=auto%20save
877 (defvar howm-auto-save-buffers-disposed nil)
878 (howm-dont-warn-free-variable auto-save-buffers-regexp)
879 (howm-dont-warn-free-variable auto-save-reject-buffers-regexp)
880 (defun howm-auto-save-buffers-p ()
881   (let ((f (howm-file-name)))
882     (and (if (boundp 'auto-save-buffers-regexp)
883              (string-match auto-save-buffers-regexp f)
884            nil)
885          (if (boundp 'auto-save-reject-buffers-regexp)
886              (not (string-match auto-save-reject-buffers-regexp f))
887            t))))
888 (defun howm-auto-save-buffers-dispose ()
889   (setq howm-menu-refresh-after-save nil)
890   (setq howm-refresh-after-save nil)
891   (setq howm-auto-save-buffers-disposed t)
892   (message "howm: Automatic refresh is disabled when auto-save-buffers is called."))
893 (defadvice auto-save-buffers (around howm-dispose activate)
894   (if (or howm-auto-save-buffers-disposed
895           (not (howm-auto-save-buffers-p)))
896       ad-do-it
897     (howm-auto-save-buffers-dispose)))
898
899 ;; howm on ChangeLog Memo
900 (defun howm-setup-change-log ()
901   (setq howm-keyword-format "\t* %s")
902   (setq howm-keyword-regexp "^\t\\(\\*\\)[ \t]+\\([^:\r\n]+\\)")
903   (setq howm-keyword-regexp-hilit-pos 1) ;; ¡Ö´ØÏ¢¥­¡¼¥ï¡¼¥É¡×ÍÑ
904   (setq howm-keyword-regexp-pos 2)
905   (setq howm-view-title-regexp "^$")
906   (setq howm-view-title-regexp-pos 0)
907   (setq howm-view-title-regexp-grep 'sorry-not-yet)
908   (setq howm-use-color nil)
909   (setq howm-menu-top nil)
910   (defadvice howm-exclude-p (around change-log (filename) activate)
911     (setq ad-return-value
912           (not (find-if (lambda (dir)
913                           (string= (howm-file-name)
914                                    (file-relative-name filename dir)))
915                         (howm-search-path)))))
916   (defadvice howm-create-file-with-title (around change-log (title) activate)
917     (howm-create-file)
918     (when (string-match howm-keyword-regexp title)
919       (setq title (match-string-no-properties howm-keyword-regexp-pos
920                                               title)))
921     (insert title))
922   (defadvice howm-create-file (around change-log
923                                       (&optional keep-cursor-p) activate)
924     (let* ((default (howm-file-name))
925            (file (expand-file-name default howm-directory))
926            (dir (file-name-directory file))
927            (buffer-file-name file)) ;; don't insert file name
928       (make-directory dir t)
929       (add-change-log-entry nil file)))
930   (add-hook 'change-log-mode-hook 'howm-mode)
931   )
932
933 ;; howm with ChangeLog Memo
934 (defvar howm-change-log-file-name "ChangeLog")
935 (defun howm-to-change-log ()
936   (interactive)
937   (let* ((title (howm-title-at-current-point))
938          (file (expand-file-name howm-change-log-file-name howm-directory))
939          ;; cheat add-change-log-entry
940          (buffer-file-name title)
941          (default-directory howm-directory))
942     (add-change-log-entry nil file)))
943 (defun howm-from-change-log ()
944   (interactive)
945   (let* ((title-regexp "^\t[*][ \t]*\\(.*\\)$")
946          (title-regexp-pos 1)
947          (title (howm-title-at-current-point nil
948                                              title-regexp title-regexp-pos)))
949     (howm-create-file-with-title title)))
950
951 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
952 ;; Bug Report
953
954 ;; Japanese is assumed at now.
955
956 (defun howm-test ()
957   "Show bug report template for howm."
958   (howm-set-lang)
959   (howm-bug-report))
960
961 (defun howm-set-lang ()
962   (set-language-environment "Japanese")
963   (set-default-coding-systems 'euc-jp)
964   (set-buffer-file-coding-system 'euc-jp-unix)
965   (set-terminal-coding-system 'euc-jp)
966   (set-keyboard-coding-system 'euc-jp)
967   )
968
969 (defun howm-compiled-p ()
970   (byte-code-function-p (symbol-function 'howm-compiled-p)))
971 (defun howm-make-file-p ()
972   (eval-when-compile
973     (getenv "HOWM_MAKE")))
974 (defun howm-test-p ()
975   (getenv "HOWM_TEST"))
976
977 (defun howm-bug-report (&optional show-sym)
978   (interactive "P")
979   (let ((report-buf (format-time-string "howm-bug-report-%Y%m%d-%H%M%S"))
980         (template "sample/bug-report.txt"))
981     (switch-to-buffer report-buf)
982     (when (not (howm-buffer-empty-p))
983       (error "Buffer %s exists (and not empty)." report-buf))
984     (if (file-exists-p template)
985         (insert-file-contents template)
986       (insert "Please copy the following text to your bug report.\n\n"))
987     (goto-char (point-max))
988     (mapc (lambda (sv)
989             (insert (format "%s: %s\n" (car sv) (cdr sv))))
990           `(
991             ("howm" . ,(howm-version-long))
992             ,@(honest-report-version-assoc)
993             ))
994     (when (eq howm-view-use-grep t)
995       (insert
996        (format "grep: %s - %s\n"
997                (cl-mapcan (lambda (d)
998                                  (let ((f (expand-file-name
999                                            howm-view-grep-command d)))
1000                                    (and (file-executable-p f)
1001                                         (list f))))
1002                                exec-path)
1003                (car (howm-call-process "grep" '("--version"))))))
1004     (when show-sym
1005       (goto-char (point-max))
1006       (insert "\n(List of variables)\n")
1007       (insert (howm-symbols-desc)))
1008     (goto-char (point-min))))
1009
1010 (defun howm-version-long ()
1011   (format "%s (compile: %s, make: %s, test: %s)"
1012           howm-version
1013           (howm-compiled-p)
1014           (howm-make-file-p)
1015           (howm-test-p)))
1016
1017 (defun howm-symbols-desc (&optional max-desc-len)
1018   (when (null max-desc-len)
1019     (setq max-desc-len 50))
1020   (apply #'concat
1021          (mapcar (lambda (sym)
1022                    (when (boundp sym)
1023                      (let ((v (format "%S" (symbol-value sym))))
1024                        (when (and (numberp max-desc-len)
1025                                   (< max-desc-len (length v)))
1026                          (setq v
1027                                (let* ((tl (/ max-desc-len 4))
1028                                       (hd (- max-desc-len tl)))
1029                                  (concat (substring v 0 hd)
1030                                          " ... "
1031                                          (substring v (- tl))))))
1032                        (format "%s: %s\n" (symbol-name sym) v))))
1033                  (sort (howm-symbols)
1034                        (lambda (x y)
1035                          (string< (symbol-name x) (symbol-name y)))))))
1036
1037 (defvar howm-required-features '(
1038                                 cheat-font-lock
1039                                 action-lock
1040                                 riffle
1041                                 gfunc
1042                                 illusion
1043                                 honest-report
1044                                 )
1045   "List of features which are required for, and distributed with, howm itself.")
1046
1047 (defun howm-prefix-names ()
1048   (mapcar #'symbol-name (cons 'howm howm-required-features)))
1049
1050 (defun howm-symbols ()
1051   (let* ((reg (format "^%s" (regexp-opt (howm-prefix-names) t)))
1052          (a nil))
1053     (mapatoms (lambda (s)
1054                 (when (string-match reg (symbol-name s))
1055                   (setq a (cons s a)))))
1056     a))
1057
1058 (defun howm-elp ()
1059   (interactive)
1060   (mapcar #'elp-instrument-package
1061           (howm-prefix-names)))
1062
1063 (defvar howm-sample-directory (expand-file-name "sample/")
1064   "for internal use")
1065 (defun howm-bug-shot ()
1066   (interactive)
1067   (let* ((version (concat "[howm] " (howm-version-long)))
1068          (init (and (howm-test-p)
1069                     (let ((f (expand-file-name "dot.emacs"
1070                                                howm-sample-directory)))
1071                       (and (file-readable-p f)
1072                            (with-temp-buffer
1073                              (insert-file-contents f)
1074                              (buffer-substring-no-properties (point-min)
1075                                                              (point-max)))))))
1076          (header (if init
1077                      (concat version "\n\n[init]\n" init)
1078                    version))
1079          (footer "--- your comment ---"))
1080     (honest-report header footer)
1081     (message "Please copy this buffer to your report.")))
1082
1083 ;;; howm-misc.el ends here