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 ;; (use-package org-tag-eldoc
  32 ;;   :ensure t
  33 ;;   :hook (org-mode . org-tag-eldoc-mode))
  34
  35 ;;; Code:
  36 \f
  37 (require 'org)
  38 (require 'org-tag-eldoc-common)
  39 (require 'org-tag-eldoc-database)
  40 (require 'org-tag-eldoc-wikipedia)
  41 (require 'org-tag-eldoc-baidu-baike)
  42 (require 'org-tag-eldoc-urban-dictionary)
  43 (require 'org-tag-eldoc-pixiv-encyclopedia)
  44 (require 'org-tag-eldoc-moegirl)
  45 (require 'subr-x)
  46 (require 'sideline)
  47
  48
  49 (defgroup org-tag-eldoc nil
  50   "Customize group of `org-tag-eldoc-mode'."
  51   :prefix "org-tag-eldoc-"
  52   :group 'org-tags)
  53
  54 (defcustom org-tag-eldoc-tag-explanation-functions
  55   '(org-tag-eldoc-database-query
  56     org-tag-eldoc-wikipedia-query
  57     org-tag-eldoc-urban-dictionary-query
  58     org-tag-eldoc-baidu-baike-query
  59     org-tag-eldoc-moegirl-query
  60     org-tag-eldoc-pixiv-encyclopedia-query)
  61   "A list of functions to be executed for query tag explanation."
  62   :type 'list
  63   :safe #'listp
  64   :group 'org-tag-eldoc)
  65
  66 (defcustom org-tag-eldoc-request-proxy
  67   (or url-proxy-services
  68       '(("http"  . "127.0.0.1:7890")
  69         ("https" . "127.0.0.1:7890")))
  70   "The proxy services inherited from `url-proxy-services'."
  71   :type 'alist
  72   :group 'org-tag-eldoc)
  73
  74 (defcustom org-tag-eldoc-display-backend 'posframe
  75   "The backend for displaying org-tag-eldoc explanation."
  76   :type '(choice (symbol :tag "posframe" 'posframe)
  77                  (symbol :tag "Eldoc" 'eldoc)
  78                  (symbol :tag "sideline" 'sideline))
  79   :safe #'symbolp
  80   :group 'org-tag-eldoc)
  81
  82 (defcustom org-tag-eldoc-sideline-display-side 'left
  83   "Display sideline text on left or right side."
  84   :type 'symbol
  85   :safe #'symbolp
  86   :group 'org-tag-eldoc)
  87
  88 (defcustom org-tag-eldoc-tag-explanations-alist
  89   '(("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.")
  90     ("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.")
  91     ("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)."))
  92   "Alist of cons cell with tag and explanation."
  93   :type 'alist
  94   :safe #'listp
  95   :group 'org-tag-eldoc)
  96
  97 (defcustom org-tag-eldoc-translation nil
  98   "Boolean value to toggle translation for explanation."
  99   :type 'boolean
 100   :safe #'booleanp)
 101
 102
 103 (defun org-tag-eldoc-translate (explanation)
 104   "Translate EXPLANATION."
 105   ;; TODO:
 106   (when org-tag-eldoc-translation
 107     )
 108   explanation)
 109
 110 (defun org-tag-eldoc--format-explanation (explanation)
 111   "Format the EXPLANATION string."
 112   ;; prettify display explanation long string.
 113   (if explanation
 114       (org-tag-eldoc-translate
 115        (string-fill
 116         (if (string-match-p "\n" explanation) ; if explanation is a large block of paragraphs.
 117             explanation
 118           ;; if only have single long line with several paragraphs, then break paragraphs into lines.
 119           (string-replace ". " ". \n\n" explanation))
 120         fill-column))
 121     (message "[org-tag-eldoc] `org-tag-eldoc--format-explanation' argument `explanation' is `nil'")))
 122
 123 (defun org-tag-eldoc-tag-explanation (&optional tag)
 124   "Display tag explanation in Eldoc when point on TAG."
 125   (let ((tag (or tag (substring-no-properties (thing-at-point 'symbol)))))
 126     (if-let ((explanation (cdr (assoc tag org-tag-eldoc-tag-explanations-alist))))
 127         (org-tag-eldoc--format-explanation explanation)
 128       (let ((explanation (seq-some
 129                           (lambda (f)
 130                             (apply f (list tag))
 131                             (unless (string-equal org-tag-eldoc--explanation "nil")
 132                               org-tag-eldoc--explanation))
 133                           org-tag-eldoc-tag-explanation-functions)))
 134         (when explanation
 135           ;; cache already queried result explanation into `org-tag-eldoc-tag-explanations-alist'.
 136           (add-to-list 'org-tag-eldoc-tag-explanations-alist (cons tag explanation))
 137           (org-tag-eldoc--format-explanation explanation))))))
 138
 139
 140 (defun org-tag-eldoc-tag-explanation-at-point ()
 141   "Get tag explanation at point."
 142   ;; NOTE: `org-element-at-point' return `headline' instead of `tags.' Need Org mode to implement it.
 143   ;; Use `thing-at-point' to workaround the missing `tags' syntax element node in `org-element-at-point' / `org-context'.
 144   (when-let* (((org-tag-eldoc-point-on-tag-p))
 145               (tag (substring-no-properties (thing-at-point 'symbol))))
 146     (org-tag-eldoc-tag-explanation tag)))
 147
 148 (defun org-tag-eldoc-point-on-tag-p ()
 149   "Detect whether current point is on Org tags."
 150   (when-let* (( (derived-mode-p 'org-mode))
 151               (position (point))
 152               ;; (limit (save-excursion (org-back-to-heading) (line-end-position)))
 153               ;; (re-search-forward org-tag-line-re limit t)
 154               (tags-region (when (org-match-line org-tag-line-re)
 155                              (cons (match-beginning 1) (match-end 1))))
 156               (point-on-tag-p (and (> position (car tags-region)) (< position (cdr tags-region)))))
 157     point-on-tag-p))
 158
 159 (defun org-tag-eldoc-posframe ()
 160   "Display org tag info in posframe popup when point moved on the tag."
 161   (if (org-tag-eldoc-point-on-tag-p)
 162       (posframe-show
 163        " *org-tag-eldoc*"
 164        :string (org-tag-eldoc-tag-explanation-at-point)
 165        :position (point)
 166        :background-color (face-attribute 'tooltip :background))
 167     (posframe-hide " *org-tag-eldoc*")))
 168
 169 (defun org-tag-eldoc-function (&rest args)
 170   "The eldoc function to be added into `eldoc-documentation-functions' with ARGS."
 171   ;; NOTE: `org-element-at-point' return `headline' instead of `tags.' Need Org mode to implement it.
 172   ;; Use `thing-at-point' to workaround the missing `tags' syntax element node in `org-element-at-point' / `org-context'.
 173   (org-tag-eldoc-tag-explanation-at-point))
 174
 175 (defun org-tag-eldoc-sideline (command)
 176   "Display org-tag-eldoc explanation based on COMMAND in sideline.
 177 Backend for sideline.
 178 Argument COMMAND is required in sideline backend."
 179   (cl-case command
 180     (`candidates (when (and (derived-mode-p 'org-mode)
 181                             ;; detect current point at tags position.
 182                             (member (thing-at-point 'symbol) (org-get-local-tags)))
 183                    (list (or (org-tag-eldoc-tag-explanation-at-point) "??"))))
 184     (`action 'org-tag-eldoc-database-update-row)
 185     (`face 'org-quote)
 186     (`name "org-tag-eldoc")))
 187
 188 (defun org-tag-eldoc-sideline-async (command)
 189   "Display org-tag-eldoc explanation based on COMMAND in sideline in async.
 190 Backend for sideline.
 191 Argument COMMAND is required in sideline backend."
 192   (cl-case command
 193     (`candidates (cons :async (when (and (derived-mode-p 'org-mode)
 194                                          ;; detect current point at tags position.
 195                                          (member (thing-at-point 'symbol) (org-get-local-tags)))
 196                                 (list (or (org-tag-eldoc-tag-explanation-at-point) "??")))))
 197     (`action 'org-tag-eldoc-database-update-row)
 198     (`face 'org-quote)
 199     (`name "org-tag-eldoc")))
 200
 201 ;;;###autoload
 202 (defun org-tag-eldoc-enable ()
 203   "Enable `org-tag-eldoc-mode'."
 204   ;; TODO: use `pre-command-hook' to implement another child-frame popup displayer function.
 205   (cl-case org-tag-eldoc-display-backend
 206     (posframe
 207      (require 'posframe)
 208      (make-local-variable 'post-command-hook)
 209      (add-hook 'post-command-hook #'org-tag-eldoc-posframe nil 'local))
 210     (sideline
 211      (sideline-mode 1)
 212      (pcase org-tag-eldoc-sideline-display-side
 213        ('left
 214         (make-local-variable 'sideline-backends-left)
 215         (add-to-list 'sideline-backends-left '(org-tag-eldoc-sideline . up))) ; or `org-tag-eldoc-sideline-async'
 216        ('right
 217         (make-local-variable 'sideline-backends-right)
 218         (add-to-list 'sideline-backends-right '(org-tag-eldoc-sideline . up)))))
 219     (eldoc
 220      (eldoc-mode 1)
 221      (make-local-variable 'eldoc-documentation-functions)
 222      ;; `eldoc-documentation-function', `eldoc-documentation-functions'
 223      (add-hook 'eldoc-documentation-functions #'org-tag-eldoc-function -10 t))))
 224
 225 ;;;###autoload
 226 (defun org-tag-eldoc-disable ()
 227   "Disable `org-tag-eldoc-mode'."
 228   (eldoc-mode -1)
 229   (remove-hook 'eldoc-documentation-functions #'org-tag-eldoc-function)
 230   (cl-case org-tag-eldoc-display-backend
 231     (posframe
 232      (remove-hook 'post-command-hook #'org-tag-eldoc-posframe))
 233     (sideline
 234      (pcase org-tag-eldoc-sideline-display-side
 235        ('left
 236         (setq-local sideline-backends-left
 237                     (delq (assoc 'org-tag-eldoc-sideline sideline-backends-left)
 238                           sideline-backends-left))
 239         (setq-local sideline-backends-left
 240                     (delq (assoc 'org-tag-eldoc-sideline-async sideline-backends-left)
 241                           sideline-backends-left)))
 242        ('right
 243         (setq-local sideline-backends-right
 244                     (delq (assoc 'org-tag-eldoc-sideline sideline-backends-right)
 245                           sideline-backends-right))
 246         (setq-local sideline-backends-right
 247                     (delq (assoc 'org-tag-eldoc-sideline-async sideline-backends-right)
 248                           sideline-backends-right))))
 249      (sideline-mode -1))
 250     (eldoc
 251      (remove-hook 'eldoc-documentation-functions #'org-tag-eldoc-function)
 252      (eldoc-mode -1))))
 253
 254 ;;;###autoload
 255 (define-minor-mode org-tag-eldoc-mode
 256   "A minor mode that display Org tag explanation through Eldoc."
 257   :init-value nil
 258   :lighter nil
 259   :group 'org-tag-eldoc
 260   :global nil
 261   (if org-tag-eldoc-mode
 262       (org-tag-eldoc-enable)
 263     (org-tag-eldoc-disable)))
 264
 265 ;;; TODO: Add mouse hover popup info support.
 266
 267
 268 \f
 269
 270 (provide 'org-tag-eldoc)
 271
 272 ;;; org-tag-eldoc.el ends here