;;; denote-wordcloud.el --- Generate a word cloud -*- lexical-binding: t -*-
;; Copyright (C) 2017-2026 by Dave Pearson <davep@davep.org>
;; Copyright (C) 2026 by Alexander Kuzmin <treflcrew@gmail.org>

;; Author: Alexander Kuzmin <treflcrew@gmail.org>
;; Package-Version: 20260506.1238
;; Package-Revision: 01a74f13bd1f
;; Keywords: files
;; URL: https://codeberg.org/treflip/denote-wordcloud
;; Package-Requires: ((emacs "28.1") (denote "4.1.3"))

;; 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 3 of the License, 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.
;;
;; You should have received a copy of the GNU General Public License along
;; with this program. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; denote-wordcloud.el generates a cloud of all known denote keywords.
;;
;; Call denote-wordcloud to display the cloud.  Keywords are
;; sorted alphabetically by default.  To sort them by frequency, prefix the
;; command call with C-u.
;;
;; When clicked, a keyword from the cloud performs a search for files that
;; contain it using denote-dired.  If a keyword is contained in only a single
;; file, that file will be opened in another window.  The search can also be
;; activated by placing the cursor on a keyword and pressing RET.

;;; Code:

(require 'cl-lib)
(require 'denote)

(defgroup denote-wordcloud nil
  "Simple word cloud generator."
  :group 'files
  :prefix "denote-wordcloud-")

(defface denote-wordcloud-face-0
  '((t :height 0.9))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defface denote-wordcloud-face-1
  '((t :height 0.92))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defface denote-wordcloud-face-2
  '((t :height 0.94))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defface denote-wordcloud-face-3
  '((t :height 0.96))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defface denote-wordcloud-face-4
  '((t :height 0.98))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defface denote-wordcloud-face-5
  '((t :height 1.0))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defface denote-wordcloud-face-6
  '((t :height 1.4))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defface denote-wordcloud-face-7
  '((t :height 1.8))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defface denote-wordcloud-face-8
  '((t :height 2.2))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defface denote-wordcloud-face-9
  '((t :height 2.5))
  "Face to use in the word cloud.

Faces run from `denote-wordcloud-face-0' (the smallest) to
`denote-wordcloud-face-9' (the biggest)."
  :group 'denote-wordcloud)

(defvar denote-wordcloud-length 10
  "The length of the word cloud.

This is the number of word sizes that are used in the cloud.  Note
that changing this will require that you add more
`denote-wordcloud-length-N' faces.")

(defcustom denote-wordcloud-ignore '("from" "that" "there" "this" "with")
  "List of words to ignore in the cloud."
  :type '(repeat string)
  :group 'denote-wordcloud)

(defcustom denote-wordcloud-min-word-length 3
  "Minimum length of a word to include in the cloud."
  :type 'integer
  :group 'denote-wordcloud)


(defun denote-wordcloud-get-word-frequency-hash ()
  "Get a hash of word frequency counts."
  (cl-loop with words = (make-hash-table :test #'equal)
           for kw in (denote-infer-keywords-from-files)
		   do (cl-incf (gethash (downcase kw) words 0))
		   finally return words))


(defun denote-wordcloud-get-word-frequency-list ()
  "Get the word count for the current buffer as a list."
  (let ((freq (denote-wordcloud-get-word-frequency-hash)))
    (cl-loop for word being the hash-key of freq
             collect (cons word (gethash word freq)))))


(defun denote-wordcloud-get-word-frequency-list-descending ()
  "Get the word count for the current buffer as a list.
The list is sorted in descending frequency order."
  (sort (denote-wordcloud-get-word-frequency-list)
        (lambda (word1 word2)
          (> (cdr word1) (cdr word2)))))

(defun denote-wordcloud-get-word-frequency-list-alpha ()
  "Get the word count for the current buffer as a list.

The list is sorted in alphabetic order."
  (sort (denote-wordcloud-get-word-frequency-list)
        (lambda (word1 word2)
          (string< (car word1) (car word2)))))

(defun denote-wordcloud-compress (words)
  "\"Compress\" the counts.

This makes a list of words, from WORDS, with their frequency and
a value related to the frequency that is compressed into the font
range."
  (let* ((counts (mapcar #'cdr words))
         (min (apply #'min counts))
         (max (apply #'max counts))
         (log-min (log (max 1 min)))
         (log-max (log (max 1 max)))
         (log-dist (- log-max log-min)))
    (mapcar (lambda (word)
              (let* ((freq (cdr word))
                     (log-freq (log (max 1 freq)))
                     (size (if (zerop log-dist)
                               (/ denote-wordcloud-length 2)
                             (truncate (* (/ (1- denote-wordcloud-length) log-dist)
                                          (- log-freq log-min))))))
                (cons (car word) (cons freq size))))
            words)))


(defun denote-wordcloud-dired (keyword)
  "Search for denote files containing KEYWORD.

Display the results in Dired."
  (denote-sort-dired keyword 'identifier t nil)
  (denote-update-dired-buffers))


(defcustom denote-wordcloud-query-func #'denote-wordcloud-dired
  "A function used to perform searches for files that contain the provided keyword.


Takes one argument KEYWORD."
  :type 'function
  :group 'denote-wordcloud)


(defvar denote-wordcloud-keyword-map
  (let ((map (make-sparse-keymap)))
    (define-key map [mouse-1] #'denote-wordcloud-activate)
    (define-key map (kbd "RET") #'denote-wordcloud-activate)
    map)
  "Keymap for `denote-wordcloud' keywords.")


(defun denote-wordcloud-activate ()
  "Activate the keyword at point."
  (interactive)
  (when-let* ((keyword (get-text-property (point) 'denote-wordcloud-keyword))
              (frequency (get-text-property (point) 'denote-wordcloud-frequency)))
    (if (= frequency 1)
		(find-file-other-window (car (denote-directory-files keyword)))
        (funcall denote-wordcloud-query-func keyword))))


;;;###autoload
(defun denote-wordcloud (by-frequency)
  "Show an interactive keyword cloud for `denote-directory-files'.


If BY-FREQUENCY is non-nil the cloud is shown sorted by
frequency, otherwise it's shown in alphabetical order."
  (interactive "P")
  (let ((words (if by-frequency
                   (denote-wordcloud-get-word-frequency-list-descending)
                 (denote-wordcloud-get-word-frequency-list-alpha))))
    (with-help-window "*denote-wordcloud*"
      (with-current-buffer standard-output
        (visual-line-mode 1)
        (cl-loop for word in (denote-wordcloud-compress words)
                 do (let* ((keyword (car word))
                           (frequency (cadr word))
                           (text (format "%s(%d)" keyword frequency)))
                      (insert
                       (propertize text
                                   'font-lock-face (intern (format "denote-wordcloud-face-%d" (cddr word)))
                                   'keymap denote-wordcloud-keyword-map
                                   'denote-wordcloud-keyword keyword
                                   'denote-wordcloud-frequency frequency
                                   'mouse-face 'highlight
                                   'help-echo keyword)
                       " ")))))))


;;;###autoload
(defun denote-wordcloud-list (by-freq)
  "Read a keyword from a frequency annotated list.
Find denote files mathing that keyword in Dired.

The completions are sorted alphabetically.
If `BY-FREQ' is provided, completions are sorted by frequency."
  (interactive "P")
  (let* ((keywords-w-freq (if by-freq
							  (denote-wordcloud-get-word-frequency-list-descending)
							  (denote-wordcloud-get-word-frequency-list-alpha)))
		  (candidates (mapcar #'car keywords-w-freq))
		  (annotate (lambda (candidate)
					  (format " (%d)" (cdr (assoc candidate keywords-w-freq)))))
		  (completion-extra-properties (list :annotation-function annotate
											 :display-sort-function #'identity))
		  (keyword (completing-read "Denote keyword: " candidates)))
	(if (= (cdr (assoc keyword keywords-w-freq)) 1)
		(find-file-other-window (car (denote-directory-files keyword)))
      (funcall denote-wordcloud-query-func keyword))))


;;;###autoload
(defun denote-wordcloud-list-by-frequency ()
  "Read a keyword from a frequency annotated list.
Find denote files mathing that keyword in Dired.

The completions are sorted by frequency."
  (interactive)
  (denote-wordcloud-list t))


(provide 'denote-wordcloud)
;;; denote-wordcloud.el ends here
