org-tag-eldoc.el

   1 ;;; org-tag-eldoc.el --- Display tag explanation in Eldoc -*- lexical-binding: t; -*-
   2 ;; -*- coding: utf-8 -*-
   3
   4 ;; Authors: stardiviner <numbchild@gmail.com>
   5 ;; Package-Requires: ((emacs "28.1") (request "0.3.3") (sideline "0.1.1"))
   6 ;; Version: 0.1.0
   7 ;; Keywords: text org
   8 ;; Homepage: https://repo.or.cz/org-tag-eldoc.git
   9
  10 ;; Copyright (C) 2024-2025 Christopher M. Miles, all rights reserved.
  11 ;;
  12 ;; org-tag-eldoc is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 3, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; org-tag-eldoc is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;;; Display tag explanation in Eldoc when point on tag.
  28
  29 ;;; Usage:
  30 ;;;
  31 ;;; (add-hook 'org-mode-hook #'org-tag-eldoc-setup)
  32
  33 ;;; Code:
  34 \f
  35 (require 'org)
  36 (require 'org-tag-eldoc-common)
  37 (require 'org-tag-eldoc-database)
  38 (require 'org-tag-eldoc-wikipedia)
  39 (require 'org-tag-eldoc-baidu-baike)
  40 (require 'org-tag-eldoc-urban-dictionary)
  41 (require 'org-tag-eldoc-pixiv-encyclopedia)
  42 (require 'org-tag-eldoc-moegirl)
  43 (require 'subr-x)
  44 (require 'sideline)
  45
  46
  47 (defgroup org-tag-eldoc nil
  48   "Customize group of `org-tag-eldoc-mode'."
  49   :prefix "org-tag-eldoc-"
  50   :group 'org-tags)
  51
  52 (defcustom org-tag-eldoc-tag-explanation-functions
  53   '(org-tag-eldoc-database-query
  54     org-tag-eldoc-wikipedia-query
  55     org-tag-eldoc-urban-dictionary-query
  56     org-tag-eldoc-baidu-baike-query
  57     org-tag-eldoc-moegirl-query
  58     org-tag-eldoc-pixiv-encyclopedia-query)
  59   "A list of functions to be executed for query tag explanation."
  60   :type 'list
  61   :safe #'listp
  62   :group 'org-tag-eldoc)
  63
  64 (defcustom org-tag-eldoc-request-proxy
  65   (or url-proxy-services
  66       '(("http"  . "127.0.0.1:7890")
  67         ("https" . "127.0.0.1:7890")))
  68   "The proxy services inherited from `url-proxy-services'."
  69   :type 'alist
  70   :group 'org-tag-eldoc)
  71
  72 (defcustom org-tag-eldoc-display-backend 'sideline
  73   "The backend for displaying org-tag-eldoc explanation."
  74   :type '(choice (symbol :tag "Eldoc" 'eldoc)
  75                  (symbol :tag "sideline" 'sideline))
  76   :safe #'symbolp
  77   :group 'org-tag-eldoc)
  78
  79 (defcustom org-tag-eldoc-tag-explanations-alist
  80   '(("Linux" . "Linux (/ˈlɪnʊks/ LIN-uuks) is a family of open-source Unix-like operating systems based on the Linux kernel, an operating system kernel first released on September 17, 1991, by Linus Torvalds.")
  81     ("Emacs" . "Emacs /ˈiːmæks/ ⓘ, originally named EMACS (an acronym for \"Editor Macros\"), is a family of text editors that are characterized by their extensibility. The manual for the most widely used variant, GNU Emacs, describes it as \"the extensible, customizable, self-documenting, real-time display editor\". Development of the first Emacs began in the mid-1970s, and work on GNU Emacs, directly descended from the original, is ongoing; its latest version is 29.2, released January 2024.")
  82     ("GNU" . "GNU (/ɡnuː/ ⓘ) is an extensive collection of free software (385 packages as of September 2023), which can be used as an operating system or can be used in parts with other operating systems. The use of the completed GNU tools led to the family of operating systems popularly known as Linux. Most of GNU is licensed under the GNU Project's own General Public License (GPL)."))
  83   "Alist of cons cell with tag and explanation."
  84   :type 'alist
  85   :safe #'listp
  86   :group 'org-tag-eldoc)
  87
  88 (defcustom org-tag-eldoc-translation nil
  89   "Boolean value to toggle translation for explanation."
  90   :type 'boolean
  91   :safe #'booleanp)
  92
  93
  94 (defun org-tag-eldoc-translate (explanation)
  95   "Translate EXPLANATION."
  96   ;; TODO:
  97   (when org-tag-eldoc-translation
  98     )
  99   explanation)
 100
 101 (defun org-tag-eldoc--format-explanation (explanation)
 102   "Format the EXPLANATION string."
 103   ;; prettify display explanation long string.
 104   (if explanation
 105       (org-tag-eldoc-translate
 106        (string-fill
 107         (if (string-match-p "\n" explanation) ; if explanation is a large block of paragraphs.
 108             explanation
 109           ;; if only have single long line with several paragraphs, then break paragraphs into lines.
 110           (string-replace ". " ". \n\n" explanation))
 111         fill-column))
 112     (message "[org-tag-eldoc] `org-tag-eldoc--format-explanation' argument `explanation' is `nil'")))
 113
 114 (defun org-tag-eldoc-tag-explanation (&optional tag)
 115   "Display tag explanation in Eldoc when point on TAG."
 116   (let ((tag (or tag (substring-no-properties (thing-at-point 'symbol)))))
 117     (if-let ((explanation (cdr (assoc tag org-tag-eldoc-tag-explanations-alist))))
 118         (org-tag-eldoc--format-explanation explanation)
 119       (let ((explanation (seq-some
 120                           (lambda (f)
 121                             (apply f (list tag))
 122                             (unless (string-equal org-tag-eldoc--explanation "nil")
 123                               org-tag-eldoc--explanation))
 124                           org-tag-eldoc-tag-explanation-functions)))
 125         (when explanation
 126           ;; cache already queried result explanation into `org-tag-eldoc-tag-explanations-alist'.
 127           (add-to-list 'org-tag-eldoc-tag-explanations-alist (cons tag explanation))
 128           (org-tag-eldoc--format-explanation explanation))))))
 129
 130
 131 (defun org-tag-eldoc-tag-explanation-at-point ()
 132   "Get tag explanation at point."
 133   ;; NOTE: `org-element-at-point' return `headline' instead of `tags.' Need Org mode to implement it.
 134   ;; Use `thing-at-point' to workaround the missing `tags' syntax element node in `org-element-at-point' / `org-context'.
 135   (when-let* ((symbol (thing-at-point 'symbol))
 136               (tag (substring-no-properties symbol))
 137               (tags (org-get-tags nil 'local)))
 138     (when (member tag tags) ; detect current point at tags position.
 139       (org-tag-eldoc-tag-explanation tag))))
 140
 141 (defun org-tag-eldoc-function (&rest args)
 142   "The eldoc function to be added into `eldoc-documentation-functions' with ARGS."
 143   ;; NOTE: `org-element-at-point' return `headline' instead of `tags.' Need Org mode to implement it.
 144   ;; Use `thing-at-point' to workaround the missing `tags' syntax element node in `org-element-at-point' / `org-context'.
 145   (org-tag-eldoc-tag-explanation-at-point))
 146
 147 (defun org-tag-eldoc-sideline (command)
 148   "Display org-tag-eldoc explanation based on COMMAND in sideline.
 149 Backend for sideline.
 150 Argument COMMAND is required in sideline backend."
 151   (cl-case command
 152     (`candidates (when (and (derived-mode-p 'org-mode)
 153                             ;; detect current point at tags position.
 154                             (member (thing-at-point 'symbol) (org-get-local-tags)))
 155                    (list (or (org-tag-eldoc-tag-explanation-at-point) "??"))))
 156     (`action 'org-tag-eldoc-database-update-row)
 157     (`face 'org-tag)
 158     (`name "org-tag-eldoc")))
 159
 160 (defun org-tag-eldoc-sideline-async (command)
 161   "Display org-tag-eldoc explanation based on COMMAND in sideline in async.
 162 Backend for sideline.
 163 Argument COMMAND is required in sideline backend."
 164   (cl-case command
 165     (`candidates (cons :async (list (org-tag-eldoc-tag-explanation-at-point))))
 166     (`action 'org-tag-eldoc-database-update-row)
 167     (`face 'org-tag)
 168     (`name "org-tag-eldoc")))
 169
 170 ;;;###autoload
 171 (defun org-tag-eldoc-enable ()
 172   "Enable `org-tag-eldoc-mode'."
 173   ;; TODO: use `pre-command-hook' to implement another child-frame popup displayer function.
 174   (cl-case org-tag-eldoc-display-backend
 175     (sideline
 176      (make-local-variable 'sideline-backends-right)
 177      (add-to-list 'sideline-backends-right '(org-tag-eldoc-sideline . up) 'append) ; or `org-tag-eldoc-sideline-async'
 178      (sideline-mode 1))
 179     (eldoc
 180      (eldoc-mode 1)
 181      (make-local-variable 'eldoc-documentation-functions)
 182      ;; `eldoc-documentation-function', `eldoc-documentation-functions'
 183      (add-hook 'eldoc-documentation-functions #'org-tag-eldoc-function -10 t))))
 184
 185 ;;;###autoload
 186 (defun org-tag-eldoc-disable ()
 187   "Disable `org-tag-eldoc-mode'."
 188   (eldoc-mode -1)
 189   (remove-hook 'eldoc-documentation-functions #'org-tag-eldoc-function)
 190   (cl-case org-tag-eldoc-display-backend
 191     (sideline
 192      (setq-local sideline-backends-right
 193                  (delq (assoc 'org-tag-eldoc-sideline sideline-backends-right)
 194                        sideline-backends-right))
 195      (sideline-mode -1))
 196     (eldoc
 197      (remove-hook 'eldoc-documentation-functions #'org-tag-eldoc-function)
 198      (eldoc-mode -1))))
 199
 200 ;;;###autoload
 201 (define-minor-mode org-tag-eldoc-mode
 202   "A minor mode that display Org tag explanation through Eldoc."
 203   :init-value nil
 204   :lighter nil
 205   :group 'org-tag-eldoc
 206   :global t
 207   (if org-tag-eldoc-mode
 208       (org-tag-eldoc-enable)
 209     (org-tag-eldoc-disable)))
 210
 211 ;;; TODO: Add mouse hover popup info support.
 212
 213
 214 \f
 215
 216 (provide 'org-tag-eldoc)
 217
 218 ;;; org-tag-eldoc.el ends here