[elpa] externals/org-real 2c716d3e54 134/188: Merge branch 'main' into next

[ELPA Syncer]

branch: externals/org-real
commit 2c716d3e549b275a077fd66acfec32600146dedf
Merge: 0f7c7db1e1 47b638ba07
Author: Amy Grinn <grinn.amy@gmail.com>
Commit: Amy Grinn <grinn.amy@gmail.com>

    Merge branch 'main' into next
---
 org-real.el | 125 +++++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 94 insertions(+), 31 deletions(-)

diff --git a/org-real.el b/org-real.el
index 872b684d98..d69e44b07e 100644
--- a/org-real.el
+++ b/org-real.el
@@ -57,6 +57,7 @@
 (require 'org-element)
 (require 'org-colview)
 (require 'cl-lib)
+(require 'ispell)
 
 ;;;; Patch! 0.0.1 -> 0.1.0+
 ;;;; Will be removed in version 1.0.0+
@@ -538,7 +539,7 @@ visibility."
     (put-text-property 0 (length primary-name) 'face 'org-real-primary
                        primary-name)
     (insert primary-name)
-    (if reversed (insert " is"))
+    (if reversed (insert (if (org-real--is-plural primary-name) " are" " is")))
     (while reversed
       (insert " ")
       (insert (plist-get container :rel))
@@ -703,6 +704,8 @@ ORIG is `org-insert-link', ARGS are the arguments passed to 
it."
               :type list)
    (metadata :initarg :metadata
              :type string)
+   (help-echo :initarg :help-echo
+             :type string)
    (rel-box :initarg :rel-box
             :type org-real-box)
    (display-rel :initarg :display-rel
@@ -944,27 +947,25 @@ button drawn."
                                (delete-char (min (length str) 
remaining-chars)))))
                      (draw-name (coords str &optional primary)
                                 (when (not arg)
-                                  (if (not locations)
-                                      (draw coords str primary)
-                                    (forward-line (- (car coords) 
(line-number-at-pos)))
-                                    (when (< (line-number-at-pos) (car coords))
-                                      (insert (make-string (- (car coords) 
(line-number-at-pos)) ?\n)))
-                                    (move-to-column (cdr coords) t)
-                                    (setq box-coords coords)
-                                    (if primary (put-text-property 0 (length 
str)
-                                                                   'face 
'org-real-primary
-                                                                   str))
-                                    (put-text-property 0 (length str)
-                                                       'cursor-sensor-functions
-                                                       (list 
(org-real--create-cursor-function box))
-                                                       str)
-                                    (insert-button str
-                                                   'help-echo "Jump to first 
occurence"
-                                                   'keymap 
(org-real--create-button-keymap box))
-                                    (let ((remaining-chars (- (save-excursion 
(end-of-line)
-                                                                              
(current-column))
+                                  (forward-line (- (car coords) 
(line-number-at-pos)))
+                                  (when (< (line-number-at-pos) (car coords))
+                                    (insert (make-string (- (car coords) 
(line-number-at-pos)) ?\n)))
+                                  (move-to-column (cdr coords) t)
+                                  (setq box-coords coords)
+                                  (if primary (put-text-property 0 (length str)
+                                                                 'face 
'org-real-primary
+                                                                 str))
+                                  (put-text-property 0 (length str)
+                                                     'cursor-sensor-functions
+                                                     (list 
(org-real--create-cursor-function box))
+                                                     str)
+                                  (insert-button str
+                                                 'help-echo "Jump to first 
occurence"
+                                                 'keymap 
(org-real--create-button-keymap box))
+                                  (let ((remaining-chars (- (save-excursion 
(end-of-line)
+                                                                            
(current-column))
                                                             (current-column))))
-                                      (delete-char (min (length str) 
remaining-chars)))))))
+                                    (delete-char (min (length str) 
remaining-chars))))))
             (draw (cons top left)
                   (concat (cond ((and double dashed) "┏")
                                 (double "╔")
@@ -1212,13 +1213,15 @@ If INCLUDE-ON-TOP is non-nil, also include height on 
top of box."
 
 (cl-defmethod org-real--create-cursor-function ((box org-real-box))
   "Create cursor functions for entering and leaving BOX."
-  (with-slots (rel rel-box display-rel-box display-rel name metadata) box
+  (with-slots (rel rel-box display-rel-box display-rel name metadata 
help-echo) box
     (let (tooltip-timer)
       (lambda (_window _oldpos dir)
         (let ((inhibit-read-only t))
           (save-excursion
             (if (eq dir 'entered)
                 (progn
+                  (if (slot-boundp box :help-echo)
+                      (message help-echo))
                   (if (slot-boundp box :metadata)
                       (setq tooltip-timer (org-real--tooltip metadata))
                     (if (and (slot-boundp box :name) (slot-boundp box :rel))
@@ -1228,7 +1231,9 @@ If INCLUDE-ON-TOP is non-nil, also include height on top 
of box."
                           (setq tooltip-timer
                                 (org-real--tooltip
                                  (with-temp-buffer
-                                   (insert (format "The %s is %s the %s."
+                                   (insert (format (concat "The %s "
+                                                           (if 
(org-real--is-plural name) "are" "is")
+                                                           " %s the %s.")
                                                    name
                                                    (if (slot-boundp box 
:display-rel)
                                                        display-rel
@@ -1245,8 +1250,8 @@ If INCLUDE-ON-TOP is non-nil, also include height on top 
of box."
                         (org-real--draw rel-box 'rel)))
                   (org-real--draw box 'selected))
               (if tooltip-timer (cancel-timer tooltip-timer))
-              (if (slot-boundp box :display-rel)
-                  (if (org-real--is-visible display-rel t)
+              (if (slot-boundp box :display-rel-box)
+                  (if (org-real--is-visible display-rel-box t)
                       (org-real--draw display-rel-box t))
                 (if (and (slot-boundp box :rel-box)
                          (org-real--is-visible rel-box t))
@@ -1314,12 +1319,14 @@ BOX is the box the button is being made for."
     (easy-mmode-define-keymap
      (mapcar
       (lambda (key) (cons (kbd (car key)) (cdr key)))
-      `(("TAB"       . ,(org-real--cycle-children box))
-        ("o"         . ,(org-real--jump-other-window box))
-        ("r"         . ,(org-real--jump-rel box))
-        ("<mouse-1>" . ,(org-real--jump-to box))
-        ("RET"       . ,(org-real--jump-to box))
-        ("M-RET"     . ,(org-real--jump-all box)))))))
+      (append
+       `(("TAB"       . ,(org-real--cycle-children box))
+         ("r"         . ,(org-real--jump-rel box)))
+       (when (and (slot-boundp box :locations) locations)
+         `(("o"         . ,(org-real--jump-other-window box))
+           ("<mouse-1>" . ,(org-real--jump-to box))
+           ("RET"       . ,(org-real--jump-to box))
+           ("M-RET"     . ,(org-real--jump-all box)))))))))
 
 ;;;; Private class methods
 
@@ -1974,6 +1981,62 @@ set to the :loc slot of each box."
            containers
            "/")))
 
+(defun org-real--is-plural (noun)
+  "Determine if any word in NOUN has a base (root) word.
+
+Uses either Ispell, aspell, or hunspell based on user settings."
+  (condition-case err
+      (progn
+        (ispell-set-spellchecker-params)
+        (let* ((words (split-string noun))
+               (orig-args (ispell-get-ispell-args))
+               (args (append
+                      (if (and ispell-current-dictionary
+                               (not (member "-d" orig-args)))
+                          (list "-d" ispell-current-dictionary))
+                      orig-args
+                      (if ispell-current-personal-dictionary
+                          (list "-p" ispell-current-personal-dictionary))
+                      (if ispell-encoding8-command
+                               (if ispell-really-hunspell
+                                         (list ispell-encoding8-command
+                                                     (upcase (symbol-name 
(ispell-get-coding-system))))
+                                       (list
+                                        (concat ispell-encoding8-command
+                                                      (symbol-name 
(ispell-get-coding-system))))))
+                      ispell-extra-args))
+               (mode (cond (ispell-really-aspell "munch")
+                           ((or ispell-really-hunspell
+                                (not (not (string-match-p "ispell" 
ispell-program-name))))
+                            "-m")
+                           (t (error (concat ispell-program-name " is not 
supported.")))))
+               (program (concat ispell-program-name " " mode " " (string-join 
args " ")))
+               (results (mapcar
+                         (lambda (word)
+                           (shell-command-to-string (concat "echo " word " | " 
program)))
+                         words)))
+          (cond
+           (ispell-really-aspell
+            (seq-some
+             (lambda (result)
+               (not (not (string-match-p "/S" result))))
+             results))
+           (ispell-really-hunspell
+            (seq-some
+             (lambda (result)
+               (not (not (string-match-p "fl:[[:alnum:]]*S[[:alnum:]]*" 
result))))
+             results))
+           ((not (not (string-match-p "ispell" ispell-program-name)))
+            (seq-some
+             (lambda (result)
+               (not (not (string-match-p "(derives from root" result))))
+             results))
+           (t
+            (error (concat ispell-program-name " is not supported."))))))
+    (error (progn
+             (message (error-message-string err))
+             nil))))
+
 (provide 'org-real)
 
 ;;; org-real.el ends here