branch: externals/org-real
commit 878480b8de773db81981f3b2f58a455cc1bf1d94
Merge: 7e51167 93cb91e
Author: Tyler Grinn <tylergr...@gmail.com>
Commit: Tyler Grinn <tylergr...@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 872b684..d69e44b 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
