emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/org-remark 16958accc2 02/75: refactor: org-remark-mark


From: ELPA Syncer
Subject: [elpa] externals/org-remark 16958accc2 02/75: refactor: org-remark-mark
Date: Fri, 6 Oct 2023 12:59:15 -0400 (EDT)

branch: externals/org-remark
commit 16958accc202be09d4b64c2b941dcf35e8c5fe3d
Author: Noboru Ota <me@nobiot.com>
Commit: Noboru Ota <me@nobiot.com>

    refactor: org-remark-mark
---
 org-remark-icon.el             |  20 ++---
 org-remark-line-highlighter.el | 176 +++++++++++++++++++++++++----------------
 org-remark.el                  |  54 +++++++++++--
 3 files changed, 163 insertions(+), 87 deletions(-)

diff --git a/org-remark-icon.el b/org-remark-icon.el
index 5ac05d3dc3..bf324f9f30 100644
--- a/org-remark-icon.el
+++ b/org-remark-icon.el
@@ -5,7 +5,7 @@
 ;; Author: Noboru Ota <me@nobiot.com>
 ;; URL: https://github.com/nobiot/org-remark
 ;; Created: 29 July 2023
-;; Last modified: 31 July 2023
+;; Last modified: 01 August 2023
 ;; Package-Requires: ((emacs "27.1") (org "9.4"))
 ;; Keywords: org-mode, annotation, note-taking, marginal-notes, wp
 
@@ -133,14 +133,16 @@ DEFAULT FACE must be a named face. It is optinal and can 
be nil.")
   "Add icons to OVERLAYS.
 Each overlay is a highlight."
   (dolist (ov overlays)
-    (cl-flet ((add-icon-maybe (icon)
-                (cl-destructuring-bind
-                    (icon-name pred default-face) icon
-                  (when (funcall pred ov)
-                    (org-remark-icon-propertize icon-name ov default-face)))))
-      (let ((icon-string
-             (mapconcat #'add-icon-maybe org-remark-icons)))
-        (when icon-string (overlay-put ov 'after-string icon-string))))))
+    (unless (string= "line" (overlay-get ov 'org-remark-type))
+      ;; icons added to line highlighters differently from normal ones.
+      (cl-flet ((add-icon-maybe (icon)
+                  (cl-destructuring-bind
+                      (icon-name pred default-face) icon
+                    (when (funcall pred ov)
+                      (org-remark-icon-propertize icon-name ov 
default-face)))))
+        (let ((icon-string
+               (mapconcat #'add-icon-maybe org-remark-icons)))
+          (when icon-string (overlay-put ov 'after-string icon-string)))))))
 
 (defun org-remark-icon-propertize (icon-name highlight default-face)
   "Return a propertized string.
diff --git a/org-remark-line-highlighter.el b/org-remark-line-highlighter.el
index 134af3104a..1b2fe949ea 100644
--- a/org-remark-line-highlighter.el
+++ b/org-remark-line-highlighter.el
@@ -5,7 +5,7 @@
 ;; Author: Noboru Ota <me@nobiot.com>
 ;; URL: https://github.com/nobiot/org-remark
 ;; Created: 01 August 2023
-;; Last modified: 01 August 2023
+;; Last modified: 02 August 2023
 ;; Package-Requires: ((emacs "27.1") (org "9.4"))
 ;; Keywords: org-mode, annotation, note-taking, marginal-notes, wp
 
@@ -28,27 +28,34 @@
 
 ;;; Code:
 
-(defun my/test-margin-left ()
-  (interactive)
-  (let* ((ov (make-overlay (line-beginning-position) 
(line-beginning-position)))
-         (left-margin (or (car (window-margins))
-                          ;; when nil = no margin, set to 1
-                          (progn (set-window-margins nil 2)
-                                 2)))
-         (spaces (- left-margin 2))
-         (string (with-temp-buffer (insert-char ?\s spaces)
-                                   (insert "‣ ")
-                                   (buffer-string))))
-    (overlay-put ov 'before-string (propertize "! " 'display
-                                               `((margin left-margin)
-                                                 ,(propertize string 'face 
'modus-themes-markup-code))))))
+;;(require 'org-remark)
 
-(defun test/get-beginning-of-line (pos)
+(defun org-remark-line-pos-bol (pos)
   "Return the beginning of the line position for POS."
   (save-excursion
     (goto-char pos)
     (pos-bol)))
 
+(defun org-remark-line-highlight-p (highlight)
+  "Return t if HIGHLIGHT is one for the line.
+HIGHLIGHT is an overlay."
+  (string= "line" (overlay-get highlight 'org-remark-type)))
+
+(defun org-remark-line-find (&optional point)
+  "Return the line-highight (overlay) of the current line.
+When POINT is passed, one for the line it belongs to. If there
+are multiple line-hilights, return the car of the list returned
+by `overlays-in'."
+  (let* ((point (or point (point)))
+         (bol (org-remark-line-pos-bol point))
+         (highlights (overlays-in bol bol)))
+    (seq-find #'org-remark-line-highlight-p highlights)))
+
+(add-hook 'org-remark-find-dwim-functions #'org-remark-line-find)
+
+(add-hook 'window-size-change-functions
+          #'(lambda (&rest args)
+              (set-window-margins nil 2)))
 
 (defun test/overlay-put-line-highlight (ov)
   (let* ((left-margin (or (car (window-margins))
@@ -57,7 +64,7 @@
                                  2)))
          (spaces (- left-margin 2))
          (string (with-temp-buffer (insert-char ?\s spaces)
-                                   (insert " ")
+                                   (insert "•")
                                    (buffer-string))))
     (overlay-put ov 'before-string (propertize "! " 'display
                                                `((margin left-margin)
@@ -65,61 +72,90 @@
     ;;(overlay-put ov 'category "org-remark-line") ;; need to fix property add 
logic
     ov))
 
+(defun org-remark-line-highlight-modified (ov after-p beg end &optional length)
+  "This is good! Move the overlay to follow the point when ENTER in the line."
+  (when after-p
+    (save-excursion (goto-char beg)
+                    (when (looking-at "\n")
+                      (move-overlay ov (1+ beg) (1+ beg))))))
+
 ;;;###autoload
 (defun org-remark-mark-line (beg end &optional id mode)
-  (interactive (org-remark-region-or-word))
-  (org-remark-line-highlight-mark beg end id mode
-                                  "line" nil ;; LINE needs to be the suffix of 
a function: `org-remark-mark-'
-                                  (list 'org-remark-type "line")))
-
-(defun org-remark-line-highlight-mark
-    (beg end &optional id mode label face properties)
-  "Apply the FACE to the whole line that contains BEG."
-  ;; Ensure to turn on the local minor mode
-  (unless org-remark-mode (org-remark-mode +1))
-  ;; When highlights are toggled hidden, only the new one gets highlighted in
-  ;; the wrong toggle state.
-  (when org-remark-highlights-hidden (org-remark-highlights-show))
-  (let ((ov (make-overlay (test/get-beginning-of-line beg) 
(test/get-beginning-of-line beg))) ;; LINE without :front-advance
-        ;; UUID is too long; does not have to be the full length
-        (id (if id id (substring (org-id-uuid) 0 8)))
-        (filename (org-remark-source-find-file-name)))
-    (if (not filename)
-        (message (format "org-remark: Highlights not saved.\
- This buffer (%s) is not supported" (symbol-name major-mode)))
-      (org-with-wide-buffer
-       ;;(overlay-put ov 'face (if face face 'org-remark-highlighter)) ;; LINE
-       (test/overlay-put-line-highlight ov) ;; LINE
-       (while properties ;; LINE add prop to indicate it is a line highlighter
-         (let ((prop (pop properties))
-               (val (pop properties)))
-           (overlay-put ov prop val)))
-       (when label (overlay-put ov 'org-remark-label label)) ;; LINE put a 
label for line (allow variations)
-       (overlay-put ov 'org-remark-id id)
-       ;; Keep track of the overlay in a local variable. It's a list that is
-       ;; guaranteed to contain only org-remark overlays as opposed to the one
-       ;; returned by `overlay-lists' that lists all overlays.
-       (push ov org-remark-highlights)
-       ;; for mode, nil and :change result in saving the highlight.  :load
-       ;; bypasses save.
-       (unless (eq mode :load)
-         (let* ((notes-buf (find-file-noselect
-                            (org-remark-notes-get-file-name)))
-                (source-buf (current-buffer))
-                ;; Get props for create and change modes
-                (notes-props
-                 (org-remark-highlight-add ov source-buf notes-buf)))
-           (when notes-props
-             (org-remark-highlight-put-props ov notes-props))
-           ;; Save the notes buffer when not loading
-          (unless (eq notes-buf (current-buffer))
-                       (with-current-buffer notes-buf (save-buffer)))))) ;; 
LINE. save-buffer triggers something that deletes this highilght
-      (deactivate-mark)
-      (org-remark-highlights-housekeep) ;;LINE is a zero width overlay! Need 
to escape them.
-      (org-remark-highlights-sort)
-      (setq org-remark-source-setup-done t)
-      ;; Return overlay
-      ov)))
+  (interactive (org-remark-beg-end 'line))
+  (org-remark-highlight-mark beg end id mode  ;; LINE line function different
+                             ;; LINE needs to be the suffix of a
+                             ;; function: `org-remark-mark-'
+                             "line" nil ;; LINE important to put
+                             ;; the suffix of the label
+                             ;; to call this correct function
+                             (list 'org-remark-type 'line)))
+
+;; (add-hook 'org-remark-beg-end-dwim-functions #'org-remark-line-beg-end)
+;; This is not a good solution. The normal highlight gets zero length with 
this.
+;; It needs to be "type" differentiated by a defmethod, etc.
+
+;; (remove-hook 'org-remark-beg-end-dwim-functions #'org-remark-line-beg-end)
+
+;; (defun org-remark-line-beg-end ()
+;;   "Return a list of beg and end both being the bol."
+;;   (let ((bol (org-remark-line-pos-bol (point))))
+;;     (list bol bol)))
+
+(cl-defmethod org-remark-beg-end ((org-remark-type (eql 'line)))
+    (let ((bol (org-remark-line-pos-bol (point))))
+      (list bol bol)))
+
+(cl-defmethod org-remark-highlight-mark-overlay (ov face (org-remark-type (eql 
'line)))
+  (test/overlay-put-line-highlight ov) ;; LINE
+  (overlay-put ov 'insert-in-front-hooks (list 
'org-remark-line-highlight-modified)))
+
+;; (defun org-remark-line-highlight-mark
+;;     (beg end &optional id mode label face properties)
+;;   "Apply the FACE to the whole line that contains BEG."
+;;   ;; Ensure to turn on the local minor mode
+;;   (unless org-remark-mode (org-remark-mode +1))
+;;   ;; When highlights are toggled hidden, only the new one gets highlighted 
in
+;;   ;; the wrong toggle state.
+;;   (when org-remark-highlights-hidden (org-remark-highlights-show))
+;;   (let ((ov (make-overlay beg end nil :front-advance))
+;;         ;; UUID is too long; does not have to be the full length
+;;         (id (if id id (substring (org-id-uuid) 0 8)))
+;;         (filename (org-remark-source-find-file-name)))
+;;     (if (not filename)
+;;         (message (format "org-remark: Highlights not saved.\
+;;  This buffer (%s) is not supported" (symbol-name major-mode)))
+;;       (org-with-wide-buffer
+;;        (org-remark-highlight-mark-overlay ov face 'line)
+;;        (while properties
+;;          (let ((prop (pop properties))
+;;                (val (pop properties)))
+;;            (overlay-put ov prop val)))
+;;        (when label (overlay-put ov 'org-remark-label label))
+;;        (overlay-put ov 'org-remark-id id)
+;;        ;; Keep track of the overlay in a local variable. It's a list that is
+;;        ;; guaranteed to contain only org-remark overlays as opposed to the 
one
+;;        ;; returned by `overlay-lists' that lists all overlays.
+;;        (push ov org-remark-highlights)
+;;        ;; for mode, nil and :change result in saving the highlight.  :load
+;;        ;; bypasses save.
+;;        (unless (eq mode :load)
+;;          (let* ((notes-buf (find-file-noselect
+;;                             (org-remark-notes-get-file-name)))
+;;                 (source-buf (current-buffer))
+;;                 ;; Get props for create and change modes
+;;                 (notes-props
+;;                  (org-remark-highlight-add ov source-buf notes-buf)))
+;;            (when notes-props
+;;              (org-remark-highlight-put-props ov notes-props))
+;;            ;; Save the notes buffer when not loading
+;;           (unless (eq notes-buf (current-buffer))
+;;                        (with-current-buffer notes-buf (save-buffer))))))
+;;       (deactivate-mark)
+;;       (org-remark-highlights-housekeep)
+;;       (org-remark-highlights-sort)
+;;       (setq org-remark-source-setup-done t)
+;;       ;; Return overlay
+;;       ov)))
 
 (provide 'org-remark-line)
 ;;; org-remark-line.el ends here
diff --git a/org-remark.el b/org-remark.el
index f7d6699f04..f144104b22 100644
--- a/org-remark.el
+++ b/org-remark.el
@@ -6,7 +6,7 @@
 ;; URL: https://github.com/nobiot/org-remark
 ;; Version: 1.1.0
 ;; Created: 22 December 2020
-;; Last modified: 01 August 2023
+;; Last modified: 02 August 2023
 ;; Package-Requires: ((emacs "27.1") (org "9.4"))
 ;; Keywords: org-mode, annotation, note-taking, marginal-notes, wp,
 
@@ -40,6 +40,8 @@
 (require 'org-remark-global-tracking)
 (declare-function org-remark-convert-legacy-data "org-remark-convert-legacy")
 
+(defvar org-remark-find-dwim-functions (list 
#'org-remark-find-overlay-at-point))
+
 
 ;;;; Customization
 
@@ -430,10 +432,10 @@ MODE is also an argument which can be passed from Elisp.  
It
 determines whether or not highlight is to be saved in the
 marginal notes file.  The expected values are nil, :load and
 :change."
-  (interactive (org-remark-region-or-word))
-  ;; FIXME
-  ;; Adding "nil" is different to removing a prop
-  ;; This will do for now
+  (interactive (org-remark-beg-end nil)) ;; passing org-remark-type nil
+    ;; FIXME
+    ;; Adding "nil" is different to removing a prop
+    ;; This will do for now
   (org-remark-highlight-mark beg end id mode
                              nil nil
                              (list 'org-remark-label "nil")))
@@ -495,7 +497,8 @@ current buffer.
 This function ensures that there is only one cloned buffer for
 notes file by tracking it."
   (interactive "d\nP")
-  (when-let ((id (get-char-property point 'org-remark-id))
+  (when-let ((id (overlay-get (org-remark-find-dwim point)
+                              'org-remark-id))
              (ibuf (org-remark-notes-buffer-get-or-create))
              (cbuf (current-buffer)))
     (pop-to-buffer ibuf org-remark-notes-display-buffer-action)
@@ -699,6 +702,23 @@ Look through `org-remark-highlights' list (in descending 
order)."
       ;; `org-remark-highlights' is sorted in the descending order .
     (seq-find (lambda (p) (< p (point))) points (nth 0 points))))
 
+(defun org-remark-find-dwim (&optional point)
+  "Return one highlight overlay for the context.
+
+It is a generic wrapper function to get and return as what the
+context requires. This is achieved via abnormal hook that passed
+the POINT as a single argument.
+
+The highligh to be returned can be the range-highlight at point.
+POINT is optional and if not passed, the current point is used.
+It can also be a line-highlight for the line, which is a zero
+length overlay put to the beginning of the line. For the latter,
+the user's point can be anywhere."
+  (or (run-hook-with-args-until-success
+       'org-remark-find-dwim-functions point)
+      ;; Fallback
+      (org-remark-find-overlay-at-point point)))
+
 (defun org-remark-find-overlay-at-point (&optional point)
   "Return one org-remark overlay at POINT.
 When point is nil, use the current point.
@@ -742,6 +762,11 @@ Optionally ID can be passed to find the exact ID match."
 ;;   functions here mostly assume the current buffer is the source
 ;;   buffer.
 
+(cl-defgeneric org-remark-highlight-mark-overlay ((org-remark-type)))
+
+(cl-defmethod org-remark-highlight-mark-overlay (ov face (org-remark-type (eql 
nil)))
+  (overlay-put ov 'face (if face face 'org-remark-highlighter)))
+
 (defun org-remark-highlight-mark
     (beg end &optional id mode label face properties)
   "Apply the FACE to the region selected by BEG and END.
@@ -780,12 +805,13 @@ round-trip back to the notes file."
   (let ((ov (make-overlay beg end nil :front-advance))
         ;; UUID is too long; does not have to be the full length
         (id (if id id (substring (org-id-uuid) 0 8)))
-        (filename (org-remark-source-find-file-name)))
+        (filename (org-remark-source-find-file-name))
+        (org-remark-type (plist-get properties 'org-remark-type)))
     (if (not filename)
         (message (format "org-remark: Highlights not saved.\
  This buffer (%s) is not supported" (symbol-name major-mode)))
       (org-with-wide-buffer
-       (overlay-put ov 'face (if face face 'org-remark-highlighter))
+       (org-remark-highlight-mark-overlay ov face org-remark-type)
        (while properties
          (let ((prop (pop properties))
                (val (pop properties)))
@@ -1264,6 +1290,7 @@ properties, add prefix \"*\"."
     (let ((p (pop props))
           (v (pop props)))
       (when (symbolp p) (setq p (symbol-name p)))
+      (when (symbolp v) (setq v (symbol-name v)))
       (when (or (string-equal "CATEGORY" (upcase p))
                 (and (> (length p) 11)
                      (string-equal "org-remark-" (downcase (substring p 0 
11)))))
@@ -1590,6 +1617,15 @@ If FILENAME is nil, return nil."
     (with-current-buffer (find-file-noselect (org-remark-notes-get-file-name))
       (funcall org-remark-source-file-name filename))))
 
+;; (defvar org-remark-beg-end-dwim-functions '(org-remark-region-or-word))
+
+;; (defun org-remark-beg-end-dwim ()
+;;   (run-hook-with-args-until-success
+;;    'org-remark-beg-end-dwim-functions))
+
+(cl-defgeneric org-remark-beg-end (org-remark-type)
+  (org-remark-region-or-word))
+
 (defun org-remark-region-or-word ()
   "Return beg and end of the active region or of the word at point.
 It is meant to be used within `interactive' in place for \"r\"
@@ -1622,6 +1658,8 @@ Return t if S1 and S2 are an identical string."
    (replace-regexp-in-string "[\n ]" "" s1)
    (replace-regexp-in-string "[\n ]" "" s2)))
 
+(load-file "~/src/org-remark/org-remark-line-highlighter.el")
+
 
 ;;;; Footer
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]