;;; -*- lexical-binding: nil; -*-
;;; howm-misc.el --- Wiki-like note-taking tool
;;; Copyright (C) 2002, 2003, 2004, 2005-2026
;;;   HIRAOKA Kazuyuki <kakkokakko@gmail.com>
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 1, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; The GNU General Public License is available by anonymouse ftp from
;;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
;;; USA.
;;;--------------------------------------------------------------------

(provide 'howm-misc)
(require 'howm)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Misc.

(defun howm-version ()
  (interactive)
  (message "howm-%s" howm-version))

(defun howm-keyword-file ()
  ;; create .howm-keys
  (when (not (file-exists-p howm-keyword-file))
    (save-excursion
      (find-file howm-keyword-file)
      (when howm-menu-top
        (goto-char (point-min))
        (insert howm-menu-top "\n"))
      (set-buffer-modified-p t)
      (save-buffer)
      (kill-buffer nil)
      (message "Generating %s ..." howm-keyword-file)
      (howm-keyword-add-items (howm-all-items))
      (message "Done.")))
  howm-keyword-file)

(add-hook 'howm-view-open-hook 'howm-set-mode)
(defun howm-set-mode ()
  (when (howm-set-mode-p)
    (howm-set-configuration-for-major-mode major-mode)
    (howm-mode 1)))

(defun howm-set-mode-p (&optional buf)
  (with-current-buffer (or buf (current-buffer))
    (let ((hdir (car (howm-search-path))))
      (and (buffer-file-name)
           (howm-folder-territory-p hdir (buffer-file-name))))))

(defvar howm-configuration-for-major-mode nil)
;; ;; sample
;; (setq howm-configuration-for-major-mode
;;   '(
;;     ;; fix me
;;     (emacs-lisp-mode
;;      . (
;;         (howm-keyword-format . "(def[a-z*]+ +%s[ \t\r\n]")
;;         (howm-keyword-regexp-format . "%s")
;;         (howm-keyword-regexp . "(\\(def[a-z]+\\) +'?\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)") ;; ' for (defalias 'xxx ...)
;;         (howm-keyword-regexp-hilit-pos . 1)
;;         (howm-keyword-regexp-pos . 2)
;;         (howm-view-title-regexp . "^(.*$")
;; ;;         (howm-view-title-regexp . "^[^; \t\r\n].*$")
;;         (howm-view-title-regexp-pos . 0)
;;         (howm-view-title-regexp-grep . "^[^; \t\r\n].*$")
;;         (howm-mode-title-face . nil)
;;         (howm-keyword-list-alias-sep . nil)
;;         (howm-view-preview-narrow . nil)
;;         ))
;;     (scheme-mode
;;      . (
;;         (howm-keyword-format . "(def[a-z]+ +[(]?%s[) \t\r\n]")
;;         (howm-keyword-regexp-format . "%s")
;;         (howm-keyword-regexp . "(\\(def[a-z]+\\) +[(]?\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)")
;;         (howm-keyword-regexp-hilit-pos . 1)
;;         (howm-keyword-regexp-pos . 2)
;;         (howm-view-title-regexp . "^[^; \t\r\n].*$")
;;         (howm-view-title-regexp-pos . 0)
;;         (howm-view-title-regexp-grep . "^[^; \t\r\n].*$")
;;         (howm-mode-title-face . nil)
;;         (howm-keyword-list-alias-sep . nil)
;;         (howm-view-preview-narrow . nil)
;;         ))
;;     (ruby-mode
;;      . (
;;         (howm-keyword-format . "\\(def\\|class\\) +%s\\b")
;;         (howm-keyword-regexp-format . "%s")
;;         (howm-keyword-regexp . "\\(def\\|class\\) +\\([-+=*/_~!@$%^&:<>{}?a-zA-Z0-9]+\\)")
;;         (howm-keyword-regexp-hilit-pos . 1)
;;         (howm-keyword-regexp-pos . 2)
;;         (howm-view-title-regexp . "^[^# \t\r\n].*$")
;;         (howm-view-title-regexp-pos . 0)
;;         (howm-view-title-regexp-grep . "^[^# \t\r\n].*$")
;;         (howm-mode-title-face . nil)
;;         (howm-keyword-list-alias-sep . nil)
;;         (howm-view-preview-narrow . nil)
;;         ))
;;     (yatex-mode
;;      . (
;;         (howm-keyword-format . "\\\\label%s")
;;         (howm-keyword-regexp-format . "%s")
;;         (howm-keyword-regexp . "\\(\\\\label\\)\\({[^}\r\n]+}\\)")
;;         (howm-keyword-regexp-hilit-pos . 1)
;;         (howm-keyword-regexp-pos . 2)
;;         (howm-view-title-regexp . "\\\\\\(\\(sub\\)*section\\|chapter\\|part\\|begin\\)")
;;         (howm-view-title-regexp-pos . 0)
;;         (howm-view-title-regexp-grep . "\\\\((sub)*section|chapter|part|begin)")
;;         (howm-mode-title-face . nil)
;;         (howm-keyword-list-alias-sep . nil)
;;         (howm-view-preview-narrow . nil)
;;         ))
;;     ))

(defun howm-set-configuration-for-file-name (f)
  (let ((mode (howm-auto-mode f)))
    (howm-set-configuration-for-major-mode mode)))

(defun howm-set-configuration-for-major-mode (mode)
  (let ((a (cdr (assoc mode howm-configuration-for-major-mode))))
    (when a  ;; I know this is redundant.
      (mapc (lambda (sv)
              (let ((symbol (car sv))
                    (value (cdr sv)))
                (set (make-local-variable symbol) value)))
            a))))

(defmacro howm-if-unbound (var &rest alt-body)
  `(if (boundp ',var) ,var ,@alt-body))

;; copied and modified from set-auto-mode in /usr/share/emacs/21.2/lisp/files.el
;; (I don't want to set the mode actually. Sigh...)
(howm-dont-warn-free-variable auto-mode-interpreter-regexp)
(defvar howm-auto-mode-interpreter-regexp
  (howm-if-unbound auto-mode-interpreter-regexp
                   ;; xemacs doesn't have it.
                   "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)"))
(defun howm-auto-mode (&optional file-name)
  "Major mode appropriate for current buffer.
This checks for a -*- mode tag in the buffer's text,
compares the filename against the entries in `auto-mode-alist',
or checks the interpreter that runs this file against
`interpreter-mode-alist'.

It does not check for the `mode:' local variable in the
Local Variables section of the file; for that, use `hack-local-variables'.

If `enable-local-variables' is nil, this function does not check for a
-*- mode tag.

This function merely returns the mode; it does not set the mode.
"
  ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
  (let (beg end done modes ans)
    (save-excursion
      (goto-char (point-min))
      (skip-chars-forward " \t\n")
      (and enable-local-variables
           ;; Don't look for -*- if this file name matches any
           ;; of the regexps in inhibit-first-line-modes-regexps.
           (let ((temp (howm-if-unbound inhibit-first-line-modes-regexps
                                        inhibit-local-variables-regexps))
                 (name (file-name-sans-versions (or file-name ""))))
             (while (let ((sufs (howm-if-unbound inhibit-first-line-modes-suffixes
                                                 inhibit-local-variables-suffixes)))
                      (while (and sufs (not (string-match (car sufs) name)))
                        (setq sufs (cdr sufs)))
                      sufs)
               (setq name (substring name 0 (match-beginning 0))))
             (while (and temp
                         (not (string-match (car temp) name)))
               (setq temp (cdr temp)))
             (not temp))
           (search-forward "-*-" (save-excursion
                                   ;; If the file begins with "#!"
                                   ;; (exec interpreter magic), look
                                   ;; for mode frobs in the first two
                                   ;; lines.  You cannot necessarily
                                   ;; put them in the first line of
                                   ;; such a file without screwing up
                                   ;; the interpreter invocation.
                                   (end-of-line (and (looking-at "^#!") 2))
                                   (point)) t)
           (progn
             (skip-chars-forward " \t")
             (setq beg (point))
             (search-forward "-*-"
                             (save-excursion (end-of-line) (point))
                             t))
           (progn
             (forward-char -3)
             (skip-chars-backward " \t")
             (setq end (point))
             (goto-char beg)
             (if (save-excursion (search-forward ":" end t))
                 ;; Find all specifications for the `mode:' variable
                 ;; and execute them left to right.
                 (while (let ((case-fold-search t))
                          (or (and (looking-at "mode:")
                                   (goto-char (match-end 0)))
                              (re-search-forward "[ \t;]mode:" end t)))
                   (skip-chars-forward " \t")
                   (setq beg (point))
                   (if (search-forward ";" end t)
                       (forward-char -1)
                     (goto-char end))
                   (skip-chars-backward " \t")
                   (push (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
                         modes))
               ;; Simple -*-MODE-*- case.
               (push (intern (concat (downcase (buffer-substring beg end))
                                     "-mode"))
                     modes)))))
    ;; If we found modes to use, set done.
    (dolist (mode (nreverse modes))
      (when (functionp mode)
        (setq ans mode)
        (setq done t)))
    ;; If we didn't find a mode from a -*- line, try using the file name.
    (if (and (not done) file-name)
        (let ((name file-name)
              (keep-going t))
	  ;; Remove backup-suffixes from file name.
	  (setq name (file-name-sans-versions name))
	  (while keep-going
	    (setq keep-going nil)
	    (let ((alist auto-mode-alist)
		  (mode nil))
	      ;; Find first matching alist entry.
	      (let ((case-fold-search
		     (memq system-type '(vax-vms windows-nt))))
		(while (and (not mode) alist)
		  (if (string-match (car (car alist)) name)
		      (if (and (consp (cdr (car alist)))
			       (nth 2 (car alist)))
			  (setq mode (car (cdr (car alist)))
				name (substring name 0 (match-beginning 0))
				keep-going t)
			(setq mode (cdr (car alist))
			      keep-going nil)))
		  (setq alist (cdr alist))))
	      (if mode
                  (setq ans mode)
		;; If we can't deduce a mode from the file name,
		;; look for an interpreter specified in the first line.
		;; As a special case, allow for things like "#!/bin/env perl",
		;; which finds the interpreter anywhere in $PATH.
		(let ((interpreter
		       (save-excursion
			 (goto-char (point-min))
			 (if (looking-at howm-auto-mode-interpreter-regexp)
			     (match-string 2)
			   "")))
		      elt)
		  ;; Map interpreter name to a mode.
		  (setq elt (assoc (file-name-nondirectory interpreter)
				   interpreter-mode-alist))
                  (if elt
                      (setq ans (cdr elt)))))))))
    ans
    ))

;; copied from /usr/share/emacs/21.2/lisp/subr.el
;; for emacs20 and xemacs
(when (not (fboundp 'replace-regexp-in-string))
  (defun replace-regexp-in-string (regexp rep string &optional
                                          fixedcase literal subexp start)
    "Replace all matches for REGEXP with REP in STRING.

Return a new string containing the replacements.

Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
arguments with the same names of function `replace-match'.  If START
is non-nil, start replacements at that index in STRING.

REP is either a string used as the NEWTEXT arg of `replace-match' or a
function.  If it is a function it is applied to each match to generate
the replacement passed to `replace-match'; the match-data at this
point are such that match 0 is the function's argument.

To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
  (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
    => \" bar foo\"
"

    ;; To avoid excessive consing from multiple matches in long strings,
    ;; don't just call `replace-match' continually.  Walk down the
    ;; string looking for matches of REGEXP and building up a (reversed)
    ;; list MATCHES.  This comprises segments of STRING which weren't
    ;; matched interspersed with replacements for segments that were.
    ;; [For a `large' number of replacments it's more efficient to
    ;; operate in a temporary buffer; we can't tell from the function's
    ;; args whether to choose the buffer-based implementation, though it
    ;; might be reasonable to do so for long enough STRING.]
    (let ((l (length string))
          (start (or start 0))
          matches str mb me)
      (save-match-data
        (while (and (< start l) (string-match regexp string start))
          (setq mb (match-beginning 0)
                me (match-end 0))
          ;; If we matched the empty string, make sure we advance by one char
          (when (= me mb) (setq me (min l (1+ mb))))
          ;; Generate a replacement for the matched substring.
          ;; Operate only on the substring to minimize string consing.
          ;; Set up match data for the substring for replacement;
          ;; presumably this is likely to be faster than munging the
          ;; match data directly in Lisp.
          (string-match regexp (setq str (substring string mb me)))
          (setq matches
                (cons (replace-match (if (stringp rep)
                                         rep
                                       (funcall rep (match-string 0 str)))
                                     fixedcase literal str subexp)
                      (cons (substring string start mb) ; unmatched prefix
                            matches)))
          (setq start me))
        ;; Reconstruct a string from the pieces.
        (setq matches (cons (substring string start l) matches)) ; leftover
        (apply #'concat (nreverse matches)))))
  )

(howm-defvar-risky howm-kill-all-enable-force nil)
(defun howm-kill-all (&optional force-p)
  "Kill all buffers which is howm-mode and unmodified."
  (interactive "P")
  (let ((anyway (and force-p howm-kill-all-enable-force)))
    (when (if anyway
              (yes-or-no-p "Discard all unsaved changes on howm-mode buffers? ")
            (y-or-n-p "Kill all howm-mode buffers? "))
      (when (eq major-mode 'howm-view-summary-mode)
        (howm-view-restore-window-configuration))
      (mapc (lambda (b)
              (when (howm-buffer-p b)
                (when anyway
                  (switch-to-buffer b)
                  (set-buffer-modified-p nil))  ;; dangerous!
                (when (not (buffer-modified-p b))
                  (kill-buffer b))))
            (buffer-list))
      (message "Done."))))

(defun howm-toggle-buffer ()
  (interactive)
  (if (howm-buffer-p)
      (howm-switch-to-nonhowm-buffer)
    (howm-switch-to-howm-buffer)))
(defun howm-switch-to-howm-buffer ()
  (interactive)
  (let ((b (howm-find-buffer #'howm-buffer-p)))
    (if b
        (switch-to-buffer b)
      (howm-menu))))
(defun howm-switch-to-nonhowm-buffer ()
  (interactive)
  (switch-to-buffer (or (howm-find-buffer #'(lambda (b)
                                              (not (howm-buffer-p b))))
                        (error "No nonhowm buffer"))))

(defun howm-find-buffer (pred)
  (catch :found
    (mapc (lambda (b)
            (cond ((howm-internal-buffer-p b) nil) ;; skip
                  ((funcall pred b) (throw :found b))
                  (t t)))
          (buffer-list))
    nil))

(defun howm-internal-buffer-p (buf)
  (string= (substring (buffer-name buf) 0 1) " "))

(defun howm-buffer-p (&optional buf)
  (let* ((indep-dirs (cons nil *howm-independent-directories*))
         (keyword-bufs (mapcar
                        (lambda (d)
                          (let ((default-directory (or d default-directory)))
                            (howm-keyword-buffer)))
                        indep-dirs)))
    (with-current-buffer (or buf (current-buffer))
      (or howm-mode
          (member major-mode
                  '(howm-view-summary-mode
                    howm-view-contents-mode))
          (member buf keyword-bufs)))))

(defun howm-mode-add-font-lock ()
  (cheat-font-lock-append-keywords (howm-mode-add-font-lock-internal)))

(defun howm-mode-add-font-lock-internal ()
  (when howm-use-color
    `(,@howm-user-font-lock-keywords
      (,howm-view-title-regexp
       (0 howm-mode-title-face prepend))
      (,howm-keyword-regexp
       (,howm-keyword-regexp-hilit-pos howm-mode-keyword-face prepend))
      (,howm-ref-regexp
       (,howm-ref-regexp-hilit-pos howm-mode-ref-face prepend))
      ,@(and howm-wiki-regexp
             `((,howm-wiki-regexp
                (,howm-wiki-regexp-pos howm-mode-wiki-face prepend))))
      )))

;;; unofficial. may be removed if no one needs them.

(defun howm-show-buffer-as-howm ()
  (interactive)
  (let* ((name (buffer-name))
         (pos (point))
         (s (buffer-substring-no-properties (point-min) (point-max)))
         (b (get-buffer-create (format "*howm[%s]*" name))))
    (set-buffer b)
    (howm-rewrite-read-only-buffer
      (insert s)
      (howm-mode 1)
      (howm-initialize-buffer))
    (goto-char pos)
    (switch-to-buffer b)))

;;; narrowing

(defun howm-narrow-to-memo ()
  "Restrict editing in this buffer to the current memo."
  (interactive)
  (apply #'narrow-to-region (howm-view-paragraph-region t)))

(defun howm-toggle-narrow ()
  "Toggle whether to restrict editing in this buffer to the current memo."
  (interactive)
  (if (howm-narrow-p)
      (widen)
    (howm-narrow-to-memo)))

(put 'howm-narrow-to-memo 'disabled t)
(put 'howm-toggle-narrow 'disabled t)

(defun howm-narrow-p ()
  (let ((b (point-min))
        (e (point-max)))
    (save-restriction
      (widen)
      (not (and (equal b (point-min))
                (equal e (point-max)))))))

(defun howm-auto-narrow ()
  (when (cond (*howm-view-item-privilege* nil)
              ((eq howm-auto-narrow t) t)
              (t (member (howm-command) howm-auto-narrow)))
    (howm-narrow-to-memo)))
;;   (when (and (member (howm-command) howm-auto-narrow)
;;              (not *howm-view-item-privilege*))

;;; select file for new memo by hand

(defun howm-create-interactively (&optional use-current-directory)
  (interactive "P")
  (find-file (read-file-name "Memo file: "
                             (if use-current-directory
                                 nil
                               howm-directory)))
  (goto-char (point-max))
  (howm-create-here))

;;; next/previous memo

(defmacro howm-save-narrowing (&rest body)
  (declare (indent 0))
  `(let ((narrowp (howm-narrow-p)))
     (when narrowp
       (widen))
     (unwind-protect
         (progn
           ,@body)
       (when narrowp
         (howm-narrow-to-memo)))))

(defun howm-next-memo (n)
  (interactive "p")
  (howm-save-narrowing
    (when (looking-at howm-view-title-regexp)
      (setq n (+ n 1)))
    (re-search-forward howm-view-title-regexp nil nil n)))

(defun howm-previous-memo (n)
  (interactive "p")
  (howm-save-narrowing
    (when (not (looking-at howm-view-title-regexp))
      (setq n (+ n 1)))
    (re-search-backward howm-view-title-regexp nil nil n)))

(defun howm-first-memo ()
  (interactive)
  (howm-save-narrowing
    (goto-char (point-min))))

(defun howm-last-memo ()
  (interactive)
  (howm-save-narrowing
    (goto-char (point-max)))
  (re-search-backward howm-view-title-regexp))

;;; random walk

(defvar howm-random-walk-buf nil "for internal use")
(defvar howm-random-walk-ro t "for internal use")

(defun howm-random-walk ()
  (interactive)
  (let ((orig-bufs (buffer-list))
        (howm-history-file nil))
    (while (let ((v (frame-visible-p (selected-frame))))
             (and v (not (eq v 'icon))
                  (not (input-pending-p))))
      (unwind-protect
          (cond ((eq major-mode 'howm-view-summary-mode)
                 (howm-random-walk-summary))
                (howm-mode
                 (howm-random-walk-text))
                (t
                 (howm-list-all)
                 (howm-random-walk-summary)))
        (mapc (lambda (b)
                (when (and (not (member b orig-bufs))
                           (null (get-buffer-window b)))
                  (kill-buffer b)))
              (buffer-list)))
      (sit-for howm-random-walk-wait))))

(defun howm-random-walk-summary ()
  (let ((n (length (riffle-item-list))))
    (goto-char (point-min))
    (forward-line (random n))
    (howm-view-summary-check)
    (sit-for howm-random-walk-wait)
    (howm-view-summary-open)))

(defun howm-random-walk-text ()
  (let* ((ks (howm-keyword-for-goto))
         (k (nth (random (length ks)) ks))
         (d (- (point-max) (point-min))))
    (goto-char (+ (point-min) (random d)))
    (if (search-forward k nil t)
        (goto-char (match-beginning 0))
      (search-backward k nil t))
    (sit-for howm-random-walk-wait)
    (howm-keyword-search k)))

;; named note

(defun howm-open-named-file ()
  "Ask a file name and open it as howm note if it is under howm directory."
  (interactive)
  (let* ((item-dir (lambda (item) (file-name-directory (howm-item-name item))))
         (dir (cond ((eq major-mode 'howm-view-summary-mode)
                     (funcall item-dir (howm-view-summary-current-item)))
                    ((eq major-mode 'howm-view-contents-mode)
                     (funcall item-dir (howm-view-contents-current-item)))
                    (t
                     howm-directory)))
         (fname (read-file-name "Howm file name: " dir)))
    (find-file fname)
    (if (file-exists-p fname)
        (howm-set-mode)
      (progn
        (howm-insert-template "")
        (howm-create-finish)))))

;; imitation of remember.el
;; http://www.emacswiki.org/cgi-bin/emacs-en/RememberMode

;; shamelessly copied from http://newartisans.com/johnw/Emacs/remember.el
;; (I cannot browse http://sacha.free.net.ph/notebook/emacs/dev today.)

(defvar howm-remember-wconf nil
  "for internal use")
(defvar howm-remember-buffer-name "*howm-remember*")
(defvar howm-remember-mode-hook nil)
(let ((m (make-sparse-keymap)))
  (define-key m "\C-c\C-c" 'howm-remember-submit)
  (define-key m "\C-c\C-k" 'howm-remember-discard)
  (howm-defvar-risky howm-remember-mode-map m))

(defun howm-remember ()
  "Add text to new note in howm."
  (interactive)
  (setq howm-remember-wconf (current-window-configuration))
  (switch-to-buffer-other-window (get-buffer-create howm-remember-buffer-name))
  (howm-remember-mode)
  (apply #'message
         `("Remember (%s) or discard (%s)."
           ,@(mapcar (lambda (f)
                       (key-description
                        (where-is-internal f howm-remember-mode-map t)))
                     '(howm-remember-submit howm-remember-discard)))))

(defun howm-remember-mode ()
  "Major mode for `howm-remember'.

\\{howm-remember-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (text-mode)
  (use-local-map howm-remember-mode-map)
  (setq major-mode 'howm-remember-mode
        mode-name "HowmRemember")
  (run-hooks 'howm-remember-mode-hook))

(defun howm-remember-submit ()
  (interactive)
  (save-excursion
    (let* ((title (howm-remember-get-title)) ;; has side effect
           (s (buffer-substring-no-properties (point-min) (point-max))))
      (set-window-configuration howm-remember-wconf)
      (howm-create-file-with-title title)
      (insert (format howm-remember-insertion-format s))
      (save-buffer)
      (kill-buffer (current-buffer))))
  (howm-remember-discard))

(defun howm-remember-get-title ()
  (if (not howm-remember-first-line-to-title)
      ""
    (progn
      (goto-char (point-min))
      (prog1
          (buffer-substring-no-properties (point-min)
                                          (line-end-position))
        (forward-line 1)
        (delete-region (point-min) (point))))))

(defun howm-remember-discard ()
  (interactive)
  (kill-buffer (current-buffer))
  (set-window-configuration howm-remember-wconf))

;; Rename buffer
;; 
;; You can rename howm buffers based on their titles.
;; Only buffer names in emacs are changed; file names are kept unchanged.
;; 
;; Add the next lines to your .emacs if you like this feature.
;; (add-hook 'howm-mode-hook 'howm-mode-set-buffer-name)
;; (add-hook 'after-save-hook 'howm-mode-set-buffer-name)
;; 
;; The original idea and code are given by Mielke-san (peter at exegenix.com).
;; http://lists.sourceforge.jp/mailman/archives/howm-eng/2006/000020.html
;; thx!

(defvar howm-buffer-name-limit 20)
(defvar howm-buffer-name-total-limit howm-buffer-name-limit)
(defvar howm-buffer-name-format "%s"
  "Buffer name format for `howm-mode-set-buffer-name'.
For example, buffer name is _ABC_ if title is ABC and the value of
this variable is \"_%s_\".")

(defun howm-truncate-string (string limit &optional dots-str)
  "Truncate STRING if it is longer than LIMIT.
For example, \"1234567...\" is returned if string is \"123456789012\"
and limit is 10.
When DOTS-STR is non-nil, it is used instead of \"...\"."
  (let ((dots (or dots-str "...")))
    (when (> (length dots) limit)
      (setq dots (substring dots 0 limit)))
    (if (> (length string) limit)
        (concat (substring string 0 (- limit (length dots)))
                dots)
      string)))

(defun howm-set-buffer-name-from-title (checker title-regexp title-regexp-pos)
  "Set the buffer name to the title(s) of the file."
  (when (funcall checker)
    (save-excursion
      (goto-char 0)
      (let ((titles nil))
        (while (re-search-forward title-regexp nil t)
          (setq titles
                (cons (match-string-no-properties title-regexp-pos)
                      titles))) 
        (let ((name0 (mapconcat  
                      (lambda (s)
                        (howm-truncate-string s howm-buffer-name-limit))
                      (reverse (cl-remove-if (lambda (s) (string= s ""))
                                                  titles))
                      "/")))
          (when (not (string= name0 "")) ;; exclude "no title" case
            (let ((name (format howm-buffer-name-format
                                (howm-truncate-string
                                 name0
                                 howm-buffer-name-total-limit))))
              (rename-buffer name t))))))))

(defun howm-mode-set-buffer-name ()
  (howm-set-buffer-name-from-title (lambda ()
                                     (and howm-mode (buffer-file-name)))
                                   howm-view-title-regexp
                                   howm-view-title-regexp-pos))

;; Automatic theming
;; https://github.com/kaorahi/howm/issues/34

(defun howm-auto-theme (&rest _)
  ;; copied from https://github.com/kaorahi/howm/issues/34#issue-2815035530
  "Adjust to the current theme by borrowing the Org-mode colors."
  (when custom-enabled-themes
    (custom-set-faces
     '(action-lock-face ((t :inherit button)))
     '(howm-mode-keyword-face ((t :inherit org-link)))
     '(howm-mode-ref-face ((t :inherit org-link)))
     '(howm-mode-title-face ((t :inherit org-level-1)))
     '(howm-mode-wiki-face ((t :inherit org-link)))
     '(howm-reminder-deadline-face ((t :inherit org-scheduled-today)))
     '(howm-reminder-late-deadline-face ((t :inherit bold :inherit org-imminent-deadline)))
     '(howm-reminder-defer-face ((t :inherit org-scheduled)))
     '(howm-reminder-scheduled-face ((t :inherit org-scheduled)))
     '(howm-reminder-done-face ((t :inherit org-done)))
     '(howm-reminder-todo-face ((t :inherit org-todo)))
     '(howm-reminder-normal-face ((t :inherit org-default)))
     '(howm-reminder-today-face ((t :inherit bold :inherit org-scheduled-today)))
     '(howm-reminder-tomorrow-face ((t :inherit bold :inherit org-scheduled)))
     '(howm-simulate-todo-mode-line-face ((t :inherit bold)))
     '(howm-view-empty-face ((t :inherit shadow)))
     '(howm-view-hilit-face ((t :inherit isearch)))
     '(howm-view-name-face ((t :inherit org-document-info))))
    (apply #'custom-set-faces howm-auto-theme-custom-entries)))

(when howm-follow-theme
  (add-hook 'enable-theme-functions #'howm-auto-theme)
  (howm-auto-theme))

;; memoize: used in howm-bayesian-set

(defun howm-memoize-put (fname value)
  (put fname 'howm-memoize value))
(defun howm-memoize-get (fname)
  (get fname 'howm-memoize))

(defun howm-memoize-call (fname func args)
  (let* ((p (assoc args (howm-memoize-get fname))))
    (if p
        (progn
;;           (message "hit %s" p)
          (cdr p))
      (let ((r (apply func args)))
        ;; We need to get it again because func can change memory.
        (howm-memoize-put fname `((,args . ,r) ,@(howm-memoize-get fname)))
        r))))

(defun howm-memoize-reset (fname)
  (howm-memoize-put fname nil))

(defmacro howm-defun-memoize (fname args &rest body)
  (declare (indent 2))
  `(progn
     (howm-memoize-reset ',fname)
     (defun ,fname ,args
       "Function generated by `howm-defun-memoize'"
       (howm-memoize-call ',fname (lambda ,args ,@body) (list ,@args)))))

;; ;; test
;; (howm-memoize-reset 'fib)
;; (howm-defun-memoize fib (n) (if (<= n 1) 1 (+ (fib (- n 1)) (fib (- n 2)))))
;; (fib 5)
;; (howm-memoize-get 'fib)

;; Bayesian set
;; 
;; "M-x howm-bayesian-set RET lisp scheme haskell RET" to estimate
;; related keywords with lisp, scheme, and haskell.
;; If you are lucky, you may find ruby, elisp, gauche, etc.
;; in estimated candidates.
;; 
;; (ref.)
;; Zoubin Ghahramani and Katherine Heller: "Bayesian Sets",
;; Advances in Neural Information Processing Systems,
;; Vol. 18, pp. 435-442, MIT Press, 2006.
;; http://books.nips.cc/nips18.html
;; http://books.nips.cc/papers/files/nips18/NIPS2005_0712.pdf

(defun howm-bset-nodup (f &rest args)
  (cl-remove-duplicates (apply f args) :test #'equal))
(defun howm-bset-mapcar (func lis)
  (howm-bset-nodup #'mapcar func lis))
(defun howm-bset-mapcan (func lis)
  (howm-bset-nodup (lambda (f z) (apply #'append (mapcar f z)))
                   func lis))

(defun howm-bset-message (&rest args)
  (let (message-log-max) ;; prevent it from being logged
    (apply #'message args)))

(defun howm-bset-matched-files (query)
;;   (howm-bset-message "Finding files for query (%s)..." query)
  (howm-bset-mapcar #'howm-item-name
                    (howm-view-search-folder-items query (howm-folder)
                                                   nil t)))

(howm-defun-memoize howm-bset-keywords-in-file* (file keyword-list)
;;   (howm-bset-message "Finding keywords in file (%s)..." file)
  (with-temp-buffer
    (insert-file-contents file)
    (howm-keyword-for-goto keyword-list)))

(defun howm-bset-keywords-in-file (file)
  (howm-bset-keywords-in-file* file nil))

(defun howm-bset-candidate-keywords (query-list)
;;   (howm-bset-message "Collecting keywords...")
  (let ((files (howm-bset-mapcan #'howm-bset-matched-files
                                 query-list)))
    (howm-bset-mapcan (lambda (f)
                        (howm-bset-message "Collecting keywords in file (%s)..."
                                           f)
                        (howm-bset-keywords-in-file f))
                      files)))

(howm-defun-memoize howm-bset-file-score (file query-list
                                               coef number-of-all-keywords)
;;   (howm-bset-message "Scoring file (%s)..." file)
  (let* ((m (/ (length (howm-bset-keywords-in-file file))
               (float number-of-all-keywords)))
         (a (* coef m))
         (b (* coef (- 1 m)))
         (s (length (howm-bset-keywords-in-file* file query-list)))
         (a2 (+ a s))
         (b2 (+ b (- (length query-list) s))))
    ;; log{(a2/a) * (b/b2)}
    (- (- (log a2) (log a)) (- (log b2) (log b)))))

(howm-defun-memoize howm-bset-keyword-score (keyword query-list
                                                     coef
                                                     number-of-all-keywords)
  (howm-bset-message "Scoring keyword (%s)..." keyword)
  (apply #'+
         (mapcar (lambda (file)
                   (howm-bset-file-score file query-list coef
                                         number-of-all-keywords))
                 (howm-bset-matched-files keyword))))

(defun howm-bset-reset ()
  (mapc #'howm-memoize-reset '(howm-bset-file-score
                               howm-bset-keyword-score
                               howm-bset-keywords-in-file*)))

(defun howm-bset (query-list)
  (howm-bset-reset)
  (unwind-protect
      (let ((n (length (howm-keyword-list)))
            (c 2.0)) ;; heuristic value
        (sort (copy-sequence (howm-bset-candidate-keywords query-list))
              (lambda (k1 k2)
                (apply #'>
                       (mapcar (lambda (k)
                                 (howm-bset-keyword-score k query-list c n))
                               (list k1 k2))))))
    (howm-bset-reset)))

(defun howm-bayesian-set (query-str)
  (interactive "sQueries: ")
  (switch-to-buffer (get-buffer-create "*howm-bayesian-set*"))
  (howm-rewrite-read-only-buffer
    (insert (mapconcat #'identity
                       (howm-bset (split-string query-str))
                       "\n"))
    (howm-mode 1))
  (goto-char (point-min))
  (howm-bset-message "Done."))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Fellowship

;; xemacs: add-to-list doesn't have APPEND
;; (add-to-list 'auto-mode-alist '("\\.howm$" . text-mode) t)
(setq auto-mode-alist (append auto-mode-alist 
                              (list '("\\.howm\\'" . text-mode))))

;; xyzzy doesn't have eval-after-load.
;; It will be useless anyway.
(when (not (fboundp 'eval-after-load))
  (defun eval-after-load (file form)
    nil))

;; xemacs canna doesn't use minor-mode. [2004-01-30]
(defvar action-lock-mode-before-canna nil)
(make-variable-buffer-local 'action-lock-mode-before-canna)
(define-advice canna:enter-canna-mode (:around (orig-fun &rest args) action-lock-fix)
  (setq action-lock-mode-before-canna action-lock-mode)
  (setq action-lock-mode nil)
  (apply orig-fun args))
(define-advice canna:quit-canna-mode (:around (orig-fun &rest args) action-lock-fix)
  (setq action-lock-mode action-lock-mode-before-canna)
  (apply orig-fun args))
 
;; for mcomplete.el [2003-12-17]
;; http://homepage1.nifty.com/bmonkey/emacs/elisp/mcomplete.el
;; error when this-command is (lambda () (interactive) ...)
(define-advice mcomplete-p (:around (orig-fun &rest args) symbol-check)
  (and (symbolp this-command)
       (apply orig-fun args)))

;; for auto-save-buffers.el [2004-01-10]
;; http://www.namazu.org/~satoru/auto-save/
;; http://homepage3.nifty.com/oatu/emacs/misc.html
;; http://www.bookshelf.jp/cgi-bin/goto.cgi?file=meadow&node=auto%20save
(defvar howm-auto-save-buffers-disposed nil)
(howm-dont-warn-free-variable auto-save-buffers-regexp)
(howm-dont-warn-free-variable auto-save-reject-buffers-regexp)
(defun howm-auto-save-buffers-p ()
  (let ((f (howm-file-name)))
    (and (if (boundp 'auto-save-buffers-regexp)
             (string-match auto-save-buffers-regexp f)
           nil)
         (if (boundp 'auto-save-reject-buffers-regexp)
             (not (string-match auto-save-reject-buffers-regexp f))
           t))))
(defun howm-auto-save-buffers-dispose ()
  (setq howm-menu-refresh-after-save nil)
  (setq howm-refresh-after-save nil)
  (setq howm-auto-save-buffers-disposed t)
  (message "howm: Automatic refresh is disabled when auto-save-buffers is called."))
(define-advice auto-save-buffers (:around (orig-fun &rest args) howm-dispose)
  (if (or howm-auto-save-buffers-disposed
          (not (howm-auto-save-buffers-p)))
      (apply orig-fun args)
    (howm-auto-save-buffers-dispose)))

;; howm on ChangeLog Memo
(defun howm-setup-change-log ()
  (setq howm-keyword-format "\t* %s")
  (setq howm-keyword-regexp "^\t\\(\\*\\)[ \t]+\\([^:\r\n]+\\)")
  (setq howm-keyword-regexp-hilit-pos 1) ;; for "related keywords"
  (setq howm-keyword-regexp-pos 2)
  (setq howm-view-title-regexp "^$")
  (setq howm-view-title-regexp-pos 0)
  (setq howm-view-title-regexp-grep 'sorry-not-yet)
  (setq howm-use-color nil)
  (setq howm-menu-top nil)
  (define-advice howm-exclude-p (:around (orig-fun filename) change-log)
          (not (cl-find-if (lambda (dir)
                             (string= (howm-file-name)
                                      (file-relative-name filename dir)))
                           (howm-search-path))))
  (define-advice howm-create-file-with-title (:around (orig-fun title) change-log)
    (howm-create-file)
    (when (string-match howm-keyword-regexp title)
      (setq title (match-string-no-properties howm-keyword-regexp-pos
                                              title)))
    (insert title))
  (define-advice howm-create-file
      (:around (orig-fun title &optional keep-cursor-p) change-log)
    (let* ((default (howm-file-name))
           (file (expand-file-name default howm-directory))
           (dir (file-name-directory file))
           (buffer-file-name file)) ;; don't insert file name
      (make-directory dir t)
      (add-change-log-entry nil file)))
  (add-hook 'change-log-mode-hook 'howm-mode)
  )

;; howm with ChangeLog Memo
(defvar howm-change-log-file-name "ChangeLog")
(defun howm-to-change-log ()
  (interactive)
  (let* ((title (howm-title-at-current-point))
         (file (expand-file-name howm-change-log-file-name howm-directory))
         ;; cheat add-change-log-entry
         (buffer-file-name title)
         (default-directory howm-directory))
    (add-change-log-entry nil file)))
(defun howm-from-change-log ()
  (interactive)
  (let* ((title-regexp "^\t[*][ \t]*\\(.*\\)$")
         (title-regexp-pos 1)
         (title (howm-title-at-current-point nil
                                             title-regexp title-regexp-pos)))
    (howm-create-file-with-title title)))

(define-minor-mode howm-org-font-lock-minor-mode
  ;; copied from https://github.com/kaorahi/howm/issues/29#issuecomment-2625076294
  ;; (fixed version of https://github.com/kaorahi/howm/issues/29#issuecomment-2571306675)
  "Minor mode to apply org-mode font locking to a buffer."
  :lighter " orgFL"
  (if howm-org-font-lock-minor-mode
      (progn
        ;; [2025-05-25]
        ;; Workaround for the error "void-variable org-element-citation-prefix-re".
        ;; Actually, just (require 'org-element) is enough,
        ;; but for future robustness, we initialize org-mode entirely for now.
        ;; https://github.com/kaorahi/howm/issues/65
        (with-temp-buffer (org-mode))  ;; workaround (#65)
        (require 'org)
        (org-set-font-lock-defaults)
        (setq-local font-lock-keywords nil)
        ;; restore howm's font-lock (#65)
        (cond ((eq major-mode 'howm-view-summary-mode)
               (howm-view-summary-mode-body))
              ((eq major-mode 'howm-view-contents-mode)
               (howm-view-contents-mode-body)))
        (font-lock-add-keywords nil org-font-lock-keywords))
    (font-lock-remove-keywords nil org-font-lock-keywords))
  (font-lock-flush)
  (font-lock-ensure))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Bug Report

;; Japanese is assumed at now.

(defun howm-test ()
  "Show bug report template for howm."
  (howm-set-lang)
  (howm-bug-report))

(defun howm-set-lang ()
  (set-language-environment "Japanese")
  (set-default-coding-systems 'utf-8)
  (set-buffer-file-coding-system 'utf-8-unix)
  (set-terminal-coding-system 'utf-8)
  (set-keyboard-coding-system 'utf-8)
  )

(defun howm-compiled-p ()
  (byte-code-function-p (symbol-function 'howm-compiled-p)))
(defun howm-make-file-p ()
  (eval-when-compile
    (getenv "HOWM_MAKE")))
(defun howm-test-p ()
  (getenv "HOWM_TEST"))

(defun howm-bug-report (&optional show-sym)
  (interactive "P")
  (let ((report-buf (format-time-string "howm-bug-report-%Y%m%d-%H%M%S"))
        (template (expand-file-name "sample/bug-report.txt" howm-directory)))
    (switch-to-buffer report-buf)
    (when (not (howm-buffer-empty-p))
      (error "Buffer %s exists (and not empty)." report-buf))
    (if (file-exists-p template)
        (insert-file-contents template)
      (insert "Please copy the following text to your bug report.\n\n"))
    (goto-char (point-max))
    (mapc (lambda (sv)
            (insert (format "%s: %s\n" (car sv) (cdr sv))))
          `(
            ("howm" . ,(howm-version-long))
            ,@(honest-report-version-assoc)
            ))
    (when (eq howm-view-use-grep t)
      (insert
       (format "grep: %s - %s\n"
               (cl-mapcan (lambda (d)
                                 (let ((f (expand-file-name
                                           (howm-grep-command) d)))
                                   (and (file-executable-p f)
                                        (list f))))
                               exec-path)
               (car (howm-call-process "grep" '("--version"))))))
    (when show-sym
      (goto-char (point-max))
      (insert "\n(List of variables)\n")
      (insert (howm-symbols-desc)))
    (goto-char (point-min))))

(defun howm-version-long ()
  (format "%s (compile: %s, make: %s, test: %s)"
          howm-version
          (howm-compiled-p)
          (howm-make-file-p)
          (howm-test-p)))

(defun howm-symbols-desc (&optional max-desc-len)
  (when (null max-desc-len)
    (setq max-desc-len 50))
  (apply #'concat
         (mapcar (lambda (sym)
                   (when (boundp sym)
                     (let ((v (format "%S" (symbol-value sym))))
                       (when (and (numberp max-desc-len)
                                  (< max-desc-len (length v)))
                         (setq v
                               (let* ((tl (/ max-desc-len 4))
                                      (hd (- max-desc-len tl)))
                                 (concat (substring v 0 hd)
                                         " ... "
                                         (substring v (- tl))))))
                       (format "%s: %s\n" (symbol-name sym) v))))
                 (sort (howm-symbols)
                       (lambda (x y)
                         (string< (symbol-name x) (symbol-name y)))))))

(defvar howm-required-features '(
                                cheat-font-lock
                                action-lock
                                riffle
                                gfunc
                                illusion
                                honest-report
                                )
  "List of features which are required for, and distributed with, howm itself.")

(defun howm-prefix-names ()
  (mapcar #'symbol-name (cons 'howm howm-required-features)))

(defun howm-symbols ()
  (let* ((reg (format "^%s" (regexp-opt (howm-prefix-names) t)))
         (a nil))
    (mapatoms (lambda (s)
                (when (string-match reg (symbol-name s))
                  (setq a (cons s a)))))
    a))

(defun howm-elp ()
  (interactive)
  (mapcar #'elp-instrument-package
          (howm-prefix-names)))

(defvar howm-sample-directory (expand-file-name "sample/")
  "for internal use")
(defun howm-bug-shot ()
  (interactive)
  (let* ((version (concat "[howm] " (howm-version-long)))
         (init (and (howm-test-p)
                    (let ((f (expand-file-name "dot.emacs"
                                               howm-sample-directory)))
                      (and (file-readable-p f)
                           (with-temp-buffer
                             (insert-file-contents f)
                             (buffer-substring-no-properties (point-min)
                                                             (point-max)))))))
         (header (if init
                     (concat version "\n\n[init]\n" init)
                   version))
         (footer "--- your comment ---"))
    (honest-report header footer)
    (message "Please copy this buffer to your report.")))

;;; howm-misc.el ends here