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

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

[elpa] externals/org-remark b3a8e3e2ec 097/173: add: Org-HANA: Org to Hi


From: ELPA Syncer
Subject: [elpa] externals/org-remark b3a8e3e2ec 097/173: add: Org-HANA: Org to Highlight & ANnotate Any text file (HANA)
Date: Fri, 28 Jan 2022 16:58:05 -0500 (EST)

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

    add: Org-HANA: Org to Highlight & ANnotate Any text file (HANA)
---
 org-hana-global-tracking.el | 107 +++++++
 org-hana.el                 | 750 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 857 insertions(+)

diff --git a/org-hana-global-tracking.el b/org-hana-global-tracking.el
new file mode 100644
index 0000000000..d484ef17e8
--- /dev/null
+++ b/org-hana-global-tracking.el
@@ -0,0 +1,107 @@
+;;; org-hana-global-tracking.el --- Track files with highlights & annotations 
-*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Noboru Ota
+
+;; Author: Noboru Ota <me@nobiot.com>
+;; URL: https://github.com/nobiot/org-hana
+;; Last modified: 02 January 2022
+;; Package-Requires: ((emacs "27.1") (org "9.4"))
+;; Keywords: org-mode, annotation, writing, note-taking, marginal-notes
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;  This file is part of org-hana
+
+;;; Code:
+
+(declare-function org-hana-mode "org-hana")
+
+(defcustom org-hana-tracking-file
+  (locate-user-emacs-file ".org-hana-tracking" nil)
+  "File name where the files `org-hana' tracks is saved.
+When `org-hana-global-tracking-mode' is active, opening a file
+saved in `org-hana-tracking-file' automatically loads highlights."
+  :group 'org-hana
+  :type 'file)
+
+(defvar org-hana-tracking-file-loaded nil)
+
+(defvar org-hana-files-tracked nil)
+
+;;;###autoload
+(define-minor-mode org-hana-global-tracking-mode
+  "Track files saved in `org-hana-tracking-file'.
+When opening any of them, automatically activates `org-hana-mode'
+locally for the file opened."
+  :init-value nil
+  :group 'org-hana
+  :lighter " ❦-tracking"
+  :global t
+  (cond
+   (org-hana-global-tracking-mode
+    ;; Activate
+    (when (and (not org-hana-tracking-file-loaded)
+              (file-exists-p org-hana-tracking-file))
+      (org-hana-tracking-load))
+    (add-hook 'find-file-hook #'org-hana-tracking-auto-on)
+    (add-hook 'kill-emacs-hook #'org-hana-tracking-save))
+   (t
+    ;; Deactivate
+    (setq org-hana-files-tracked nil)
+    (setq org-hana-tracking-file-loaded nil)
+    (remove-hook 'find-file-hook #'org-hana-tracking-auto-on)
+    (remove-hook 'kill-emacs-hook #'org-hana-tracking-save))))
+
+;;;; Private Functions
+
+(defun org-hana-tracking-auto-on ()
+  "Activate `org-hana-mode' when file is being tracked.
+The files being tracked are loaded on to
+`org-hana-files-tracked'.  Refer to
+`org-hana-tracking-load'."
+  (when (and org-hana-files-tracked
+            (member (abbreviate-file-name (buffer-file-name))
+                    org-hana-files-tracked))
+    (unless (featurep 'org-hana) (require 'org-hana))
+    (org-hana-mode +1)))
+
+(defun org-hana-tracking-load ()
+  "Load files being tracked from `org-hana-tracking-file'.
+It has one filename each line.  The filename is obtrained
+`abbreviated-file-names'.  This function reloads the content of
+the file regardless if it is already done in this Emacs session
+or not."
+  (with-temp-buffer
+    (condition-case nil
+       (progn
+         (insert-file-contents org-hana-tracking-file)
+         (setq org-hana-files-tracked
+               (split-string (buffer-string) "\n"))
+          (setq org-hana-tracking-file-loaded t)))))
+
+(defun org-hana-tracking-save ()
+  "Save files being tracked in `org-hana-tracking-file'.
+Files with marginal notes are tracked with variable
+`org-hana-files-tracked'."
+  (interactive)
+  (when org-hana-files-tracked
+    (with-temp-file org-hana-tracking-file
+      (insert (mapconcat 'identity org-hana-files-tracked "\n")))))
+
+(provide 'org-hana-global-tracking)
+
+;;; org-hana-global-tracking.el ends here
diff --git a/org-hana.el b/org-hana.el
new file mode 100644
index 0000000000..974d2cef8f
--- /dev/null
+++ b/org-hana.el
@@ -0,0 +1,750 @@
+;;; org-hana.el --- Highlight & ANnotate Any text file (HANA) -*- 
lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2022 Noboru Ota
+
+;; Author: Noboru Ota <me@nobiot.com>
+;; URL: https://github.com/nobiot/org-hana
+;; Version: 0.0.7
+;; Last modified: 02 January 2022
+;; Package-Requires: ((emacs "27.1") (org "9.4"))
+;; Keywords: org-mode, annotation, writing, note-taking, marginal-notes
+
+;; This file is not part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package lets you highlight and annote any text file in a separate Org
+;; file.  Refer to README.org and docstring for detail.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'org)
+(require 'org-id)
+(require 'org-hana-global-tracking)
+(declare-function org-collect-keywords "org")
+
+;;;; Customization
+
+(defgroup org-hana nil
+  "Highlight and annote any text file in a separate Org file."
+  :group 'org
+  :prefix "org-hana-"
+  :link '(url-link :tag "Github" "https://github.com/nobiot/org-hana";))
+
+(defface org-hana-highlighter
+  '((((class color) (min-colors 88) (background light))
+     :underline "#aecf90" :background "#ecf7ed")
+    (((class color) (min-colors 88) (background dark))
+     :underline "#00422a" :background "#001904")
+    (t
+     :inherit highlight))
+  "Face for the default highlighter pen.")
+
+(defcustom org-hana-notes-file-path "margin-notes.org"
+  "Specify the file path to store the location of highlights and annotations.
+The default is one file per directory.  Ensure that it is an Org
+file."
+  :type 'file)
+
+(defcustom org-hana-use-org-id t
+  "Define if Org-HANA use Org-ID to link back to the main note."
+  :type 'boolean)
+
+;;;; Variables
+
+(defvar-local org-hana-loaded nil
+  "Indicate if hightlights have been loaded onto current buffer.")
+
+(defvar-local org-hana-highlights '()
+  "Keep track of all the highlights in current buffer.
+It is a local variable and is a list of overlays.  Each overlay
+represents a highlighted text region.
+
+On `save-buffer' each highlight will be save in the notes file at
+`org-hana-notes-file-path'.")
+
+(defvar org-hana-last-notes-buffer nil
+  "Stores the cloned indirect buffer visting the notes file.
+It is meant to exist only one of these in each Emacs session.")
+
+;; Const for the names of properties in Org Mode
+;; Kept for backward compatiblity reasons
+(defconst org-hana-prop-id "marginalia-id")
+(defconst org-hana-prop-source-file "marginalia-source-file")
+(defconst org-hana-prop-source-beg "marginalia-source-beg")
+(defconst org-hana-prop-source-end "marginalia-source-end")
+
+;;;; Commands
+
+;;;###autoload
+(define-minor-mode org-hana-mode
+    "Highlight text, write margin notes for any text file in Org Mode.
+This is a local minor-mode.
+
+On activation, it loads your saved highlights from the marginalia
+file and enables automatic saving of highlights.
+
+The automatic saving is achieved via function
+`org-hana-save' added to `after-save-hook'.
+
+On deactivation, it removes all the overlays and stops tracking
+the highlights in this buffer by setting variable
+`org-hana-highlights' to nil.  Be careful of behavior, if
+you still wish to retain the locations of highlights.
+
+It is recommended to use `org-hana-toggle' if you wish to
+temporarily hide highlights in the current buffer.  It keeps
+`org-hana-highlights' unchanged.
+
+While the tracking of highlights is stopped,
+editing the buffer will likely result in mismatch between the
+saved highlights' locations and the current buffer's text
+content.
+
+Highlights tracked by variable `org-hana-highlights' cannot
+persist when you kill the buffer or quit Emacs.  When you
+re-launch Emacs and visit the same file, ensure to turn on
+`org-hana-mode' to load the highlights from the marginalia
+file.  `org-hana-global-tracking-mode' can automate this.
+
+\\{org-hana-mode-map}"
+    :init-value nil
+    :lighter " ❦"
+    :global nil
+    :keymap (let ((map (make-sparse-keymap)))
+              map)
+    (cond
+     (org-hana-mode
+      ;; Activate
+      (org-hana-load)
+      (add-hook 'after-save-hook #'org-hana-save nil t)
+      (add-hook 'kill-buffer-hook #'org-hana-tracking-save nil t))
+     (t
+      ;; Deactivate
+      (when org-hana-highlights
+       (dolist (highlight org-hana-highlights)
+         (delete-overlay highlight)))
+      (setq org-hana-highlights nil)
+      (setq org-hana-loaded nil)
+      (org-hana-tracking-save)
+      (remove-hook 'after-save-hook #'org-hana-save t)
+      (remove-hook 'kill-buffer-hook #'org-hana-tracking-save t))))
+
+;;; `org-hana-create-pen' macro lets you create commands for different 
highlighter pens
+;;; Org-HANA provides three default ones. See below after `org-hana-create-pen'
+(defmacro org-hana-create-pen (&optional label face properties)
+  "Create a user-defined highlighter function.
+LABEL is the name of the highlighter.  The function will be called
+`org-hana-mark-LABEL', or, when LABEL is nil, the default
+`org-hana-mark'.
+
+The highlighter function will apply FACE to the selected region.
+FACE can be an anonymous face.  When it is nil, this macro uses
+the default face `org-hana-highlight'.
+
+PROPERTIES is a list of pairs of a symbol and value.  Each
+highlighted text region will have a corresponding Org headline in
+the notes file, and it can have properties from the highlighter
+pen.  To do this, prefix property names with \"org-hana-\" or use
+\"CATEGORY\"."
+  `(defun ,(intern (or (when label (format "org-hana-mark-%s" label))
+                       "org-hana-mark"))
+       (beg end &optional id)
+     ,(format "Apply the following face to the region selected by BEG and END.
+%s
+
+Following properties are also added to the notes file:
+%S
+
+When this function is used interactively. it will generate a new
+ID, always assuming it is a new highlighted text region, and
+start tracking the highlight's location, so that you can edit the
+text around.
+
+It will not create a marginalia entry yet. Save the current
+buffer or call `org-hana-save' to create a new entry (it is
+automatic with `after-save-hook').
+
+When this function is called from Elisp, ID can be optionally
+passed. If so, no new ID gets generated.
+
+Every highlighted text region in the current buffer is tracked by
+local variable `org-hana-highlights'. The highlights are
+sorted in the ascending order; this is a property of the variable
+used for `org-hana-next' and `org-hana-prev'."
+              (or face "`org-hana-highlight'") properties)
+     (interactive "r")
+     (org-hana-highlight beg end ,label ,face ,properties id)))
+
+;; Don't use category (symbol) as a property -- it's a special one of text
+;; properties. If you use it, the value also need to be a symbol; otherwise, 
you
+;; will get an error. You can use CATEGORY (symbol and all uppercase).
+
+(org-hana-create-pen) ;; create the default mark function with default face
+                      ;; `org-hana-highlight' with no properties.
+(org-hana-create-pen "orange"
+                           '(:underline (:color "dark red" :style wave) 
:background "coral" :weight bold)
+                           '(CATEGORY "must"))
+(org-hana-create-pen "yellow"
+                           '(:underline "gold" :background "lemon chiffon") 
'(CATEGORY "important"))
+
+;;;###autoload
+(defun org-hana-load ()
+  "Visit `org-hana-notes-file' & load the saved highlights onto current buffer.
+If there is no highligths or annotations for current buffer,
+output a message in the echo.
+
+Highlights tracked locally by variable `org-hana-highlights'
+cannot persist when you kill current buffer or quit Emacs.  It is
+recommended to set `org-hana-global-tracking-mode' in your
+configuration.  It automatically turns on `org-hana-mode', which
+runs `org-hana-load' for current buffer.
+
+Otherwise, do not forget to turn on `org-hana-mode' manually to
+load the highlights"
+  (interactive)
+  (unless org-hana-mode (org-hana-mode +1))
+  (unless org-hana-loaded
+    (when-let* ((filename (buffer-file-name))
+               (notes-buf (find-file-noselect org-hana-notes-file-path))
+               (source-path (abbreviate-file-name filename)))
+      ;; Get hilights: each highlighlight is stored as an alist
+      ;; TODO check if there is any relevant notes for the current file
+      (let ((highlights '()))
+       (with-current-buffer notes-buf
+          (org-with-wide-buffer
+           (let ((heading (org-find-property
+                          org-hana-prop-source-file source-path)))
+             (if (not heading)
+                (message "No highlights or annotations found for %s." 
source-path)
+               (goto-char (org-find-property
+                          org-hana-prop-source-file source-path))
+               ;; Narrow to only subtree for a single file.  
`org-find-property'
+               ;; ensures that it is the beginning of a headline
+               (org-narrow-to-subtree)
+               ;; It's important that the headline levels are fixed
+               ;; H1: File
+               ;; H2: Higlighted region (each one has a dedicated H2 subtree)
+               (while (not (org-next-visible-heading 1))
+                 ;; The `or' for backward compatibility.  The consts are no
+                 ;; longer used in the current version
+                (when-let ((id (or
+                                 (org-entry-get (point) "org-hana-id")
+                                 (org-entry-get (point) org-hana-prop-id)))
+                            (beg (string-to-number
+                                  (or
+                                   (org-entry-get (point)
+                                                 "org-hana-source-beg")
+                                  (org-entry-get (point)
+                                                 org-hana-prop-source-beg))))
+                            (end (string-to-number
+                                  (or
+                                   (org-entry-get (point)
+                                                 "org-hana-source-end")
+                                  (org-entry-get (point)
+                                                 org-hana-prop-source-end)))))
+                   (push (list id
+                               (cons beg end)
+                               (org-entry-get (point) "org-hana-label"))
+                         highlights)))))))
+       ;; Back to the current buffer
+       ;; Loop highilights and add them to the current buffer
+        ;; Each highlight is a list in the following structure:
+        ;;
+        ;;     (id (beg . end) label)
+        ;;
+       (dolist (highlight highlights)
+          (let ((id (car highlight))
+               (beg (caadr highlight))
+               (end (cdadr highlight))
+                (label (caddr highlight)))
+            (let ((fn (intern (concat "org-hana-mark-" label))))
+              (unless (functionp fn) (setq fn #'org-hana-mark))
+              (funcall fn beg end id))))))
+    ;; Tracking
+    (when org-hana-global-tracking-mode
+      (add-to-list 'org-hana-files-tracked
+                  (abbreviate-file-name (buffer-file-name))))
+    (setq org-hana-loaded t)))
+
+(defun org-hana-save ()
+  "Save all the highlights tracked in current buffer to notes file.
+Variable`org-hana-notes-file-path' defines the file path.
+
+This funcion is automatically called when you save the current
+buffer via `after-save-hook'.  This function is added to it by
+function `org-hana-mode' when you activate the minor mode.
+
+When `org-hana-global-tracking-mode' is on, this function also
+adds current buffer to variable `org-hana-files-tracked' so that
+next time you visit this file, `org-hana-mode' can be
+automatically turned on to load the highlights.
+
+`org-hana-highlights' is the local variable that tracks every highlight
+in the current buffer.  Each highlight is represented by an overlay."
+  (interactive)
+  (let* ((filename (buffer-file-name))
+         (source-path (abbreviate-file-name filename))
+         (title (or (cadr (assoc "TITLE" (org-collect-keywords '("TITLE"))))
+                    (file-name-sans-extension
+                    (file-name-nondirectory (buffer-file-name))))))
+    (org-hana-housekeep)
+    (org-hana-sort-highlights-list)
+    (dolist (h org-hana-highlights)
+      (let ((orgid (and org-hana-use-org-id
+                       (org-entry-get (overlay-start h) "ID" 'INHERIT))))
+       (org-hana-save-single-highlight h title source-path orgid)))
+    ;; Tracking
+    (when org-hana-global-tracking-mode
+      (add-to-list 'org-hana-files-tracked
+                  (abbreviate-file-name (buffer-file-name))))))
+
+(defun org-hana-open (point)
+  "Open hightlight and annocation at POINT, narrowed to the relevant headline.
+It creates a cloned indirect buffer of the notes file
+\(`org-hana-notes-file-path'\).  You can edit notes file as a in
+a normal Org file.  Once you have done editing, you can simply
+save and kill the buffer.
+
+This package ensures that there is only one cloned buffer for
+notes file by tracking it."
+  (interactive "d")
+  (when (buffer-live-p org-hana-last-notes-buffer)
+    (kill-buffer org-hana-last-notes-buffer))
+  (when-let ((id (get-char-property point 'org-hana-id))
+             (ibuf (make-indirect-buffer
+                    (find-file-noselect org-hana-notes-file-path)
+                   "*marginal notes*" 'clone)))
+    (setq org-hana-last-notes-buffer ibuf)
+    (org-switch-to-buffer-other-window ibuf)
+    (widen)(goto-char (point-min))
+    (when (org-find-property org-hana-prop-id id)
+      (goto-char (org-find-property org-hana-prop-id id))
+      (org-narrow-to-subtree))))
+
+(defun org-hana-remove (point &optional arg)
+  "Remove the highlight at POINT.
+It will remove the highlight and the properties from the
+marginalia, but will keep the headline and notes.  This is to
+ensure to keep any notes you might have written intact.
+
+You can let this command delete the entire heading subtree for
+the highlight, along with the annotations you have written, pass
+a universal argument with \\[universal-argument] \(ARG\).  If you
+have done so by error, you could still `undo' it in the notes
+buffer, but not in the current buffer as adding and removing overlays
+are not part of the undo tree."
+  (interactive "d\nP")
+  ;; TODO There may be multiple overlays
+  (when-let* ((id (get-char-property point 'org-hana-id)))
+    ;; Remove the highlight overlay and id
+    (dolist (ov (overlays-at (point)))
+      ;; Remove the element in the variable org-hana-highlights
+      (when (overlay-get ov 'org-hana-id)
+       (delete ov org-hana-highlights)
+       (delete-overlay ov)))
+    (org-hana-housekeep)
+    (org-hana-sort-highlights-list)
+    ;; Update the notes file accordingly
+    (org-hana-remove-single-highlight id arg)
+    t))
+
+(defun org-hana-next ()
+  "Move to the next highlight, if any.
+If there is none below the point but there is a highlight in the
+buffer, cycle back to the first one.
+
+After the point has moved to the next highlight, this command
+lets you move further by re-entering only the last letter like
+this example:
+
+   C-n \] \] \] \] \] \(assuming this command is bound to C-n \]\)
+
+This is achieved by transient map with `set-transient-map'.
+
+If you have the same prefix for `org-hana-prev', you can combine it in
+the sequence like so:
+
+   C-n \] \] \] \[ \["
+  (interactive)
+  (if (not org-hana-highlights)
+      (progn (message "No highlights present in this buffer.") nil)
+    (let ((p (org-hana-find-next-highlight)))
+      (if p (progn
+              (goto-char p)
+              ;; Setup the overriding keymap.
+              (unless overriding-terminal-local-map
+                (let ((prefix-keys (substring (this-single-command-keys) 0 -1))
+                      (map (cdr org-hana-mode-map)))
+                  (when (< 0 (length prefix-keys))
+                    (mapc (lambda (k) (setq map (assq k map))) prefix-keys)
+                    (setq map (cdr-safe map))
+                    (when (keymapp map) (set-transient-map map t)))))
+              t)
+        (message "Nothing done. No more visible highlights exist") nil))))
+
+(defun org-hana-prev ()
+  "Move to the previous highlight, if any.
+If there is none above the point, but there is a highlight in the
+buffer, cycle back to the last one.
+
+After the point has moved to the previous highlight, this command
+lets you move further by re-entering only the last letter like
+this example:
+
+   C-n \[ \[ \[ \[ \[ \(assuming this command is bound to C-n \[\)
+
+This is achieved by transient map with `set-transient-map'.
+
+If you have the same prefix for `org-hana-next', you can combine it in
+the sequence like so:
+
+   C-n \] \] \] \[ \["
+  (interactive)
+  (if (not org-hana-highlights)
+      (progn (message "No highlights present in this buffer.") nil)
+    (let ((p (org-hana-find-prev-highlight)))
+      (if p (progn
+              (goto-char p)
+              ;; Setup the overriding keymap.
+              (unless overriding-terminal-local-map
+                (let ((prefix-keys (substring (this-single-command-keys) 0 -1))
+                      (map (cdr org-hana-mode-map)))
+                  (when (< 0 (length prefix-keys))
+                    (mapc (lambda (k) (setq map (assq k map))) prefix-keys)
+                    (setq map (cdr-safe map))
+                    (when (keymapp map) (set-transient-map map t)))))
+              t)
+        (message "Nothing done. No more visible highlights exist") nil))))
+
+(defun org-hana-toggle ()
+  "Toggle showing/hiding of highlighters in current buffer.
+It only affects the display of the highlighters.  Their locations
+are still kept tracked; upon buffer-save the correct locations
+are still recorded in the marginalia file."
+  (interactive)
+  (when-let ((highlights org-hana-highlights))
+    ;; Check the first highlight in the buffer
+    ;; If it's hidden, all hidden. Show them.
+    ;; If not, all shown. Hide them.
+    (if-let* ((beg (overlay-start (nth 0 highlights)))
+              (hidden-p (get-char-property beg 'org-hana-hidden)))
+        (org-hana-show)
+      (org-hana-hide))
+    t))
+
+;;;; Functions
+
+;;;;; Private
+
+(defun org-hana-highlight (beg end label face properties &optional id)
+  "Highlight the selected region between BEG and END.
+This function performs the main work for the command created via
+`org-hana-create-pen'.
+
+Create a user-defined highlighter function.
+LABEL is the name of the highlighter.  The function will be called
+`org-hana-mark-LABEL', or, when LABEL is nil, the default
+`org-hana-mark'.
+
+The highlighter function will apply FACE to the selected
+region.  FACE can be an anonymous face.  When it is nil, this
+macro uses the default face `org-hana-highlight'.
+
+PROPERTIES is a list of pairs of a symbol and value.  Each
+highlighted text region will have a corresponding Org headline in
+the notes file, and it can have properties from the highlighter
+pen.  To do this, prefix property names with \"org-hana-\" or use
+\"CATEGORY\".
+
+When this function is called from Elisp, ID can be optionally
+passed. If so, no new ID gets generated."
+  ;; Ensure to turn on the local minor mode
+  (unless org-hana-mode (org-hana-mode +1))
+  ;; UUID is too long; does not have to be the full length
+  (when (not id) (setq id (substring (org-id-uuid) 0 8)))
+  ;; Add highlight to the text
+  (org-with-wide-buffer
+   (let ((ov (make-overlay beg end nil 'FRONT-ADVANCE)))
+     (overlay-put ov 'face (if face face 'org-hana-highlighter))
+     (while properties
+       (let ((prop (pop properties))
+             (val (pop properties)))
+         (overlay-put ov prop val)))
+     (when label (overlay-put ov 'org-hana-label label))
+     (overlay-put ov 'org-hana-id id)
+     ;; Keep track of the overlay in a local variable. It's a list that is
+     ;; guranteed to contain only org-hana overlays as opposed to the one
+     ;; returned by `overlay-lists' that lists any overlays.
+     (push ov org-hana-highlights)
+     ;; Adding overlay to the buffer does not set the buffer modified. You
+     ;; cannot use `undo' to undo highlighter, either.
+     (deactivate-mark)
+     (unless (buffer-modified-p) (restore-buffer-modified-p t))))
+  (org-hana-housekeep)
+  (org-hana-sort-highlights-list))
+
+(defun org-hana-save-single-highlight (highlight title path orgid)
+  "Save a single HIGHLIGHT in the notes file with properties.
+The notes file is specified by PATH.
+
+For the first highlight for current buffer, it will create a new
+H1 headline for it.
+
+If it is a new highlight, create a new H2 headline with the TITLE
+as its headline text at the end of the H1 headline for the
+current buffer.
+
+If headline with the same ID already exists, update its position,
+while keep the headline text intact, because the user might have
+changed it to their needs.
+
+ORGID can be passed to this function.  If user option
+`org-hana-use-org-id' is non-nil, this function will create a
+link back to the source via an Org-ID link with using ORGID
+instead of the normal file link.
+
+When a new notes file is created and `org-hana-use-org-id' is
+non-nil, this function adds ID property to the file level.  This
+can be helpful with other packages such as Org-roam's backlink
+feature."
+  (let* ((beg (overlay-start highlight))
+         (end (overlay-end highlight))
+        (id (overlay-get highlight 'org-hana-id))
+         ;;`org-with-wide-buffer is a macro that should work for non-Org file'
+         (text (org-with-wide-buffer (buffer-substring-no-properties beg end)))
+         (props (overlay-properties highlight)))
+    ;; TODO Want to add a check if save is applicable here.
+    (with-current-buffer (find-file-noselect org-hana-notes-file-path)
+      ;; If it is a new empty marginalia file
+      (when (and (org-hana-empty-buffer-p) org-hana-use-org-id)
+       (org-id-get-create))
+      (org-with-wide-buffer
+       (let ((file-headline (or (org-find-property
+                                org-hana-prop-source-file path)
+                                (progn
+                                  ;; If file-headline does not exist, create 
one at the bottom
+                                  (goto-char (point-max))
+                                  ;; Ensure to be in the beginning of line to 
add a new headline
+                                  (when (eolp) (open-line 1) (forward-line 1) 
(beginning-of-line))
+                                  (insert (concat "* " title "\n"))
+                                  (org-set-property org-hana-prop-source-file 
path)
+                                  (org-up-heading-safe) (point))))
+             (id-headline (org-find-property org-hana-prop-id id)))
+         (if id-headline
+             (progn
+               (goto-char id-headline)
+                ;; Update the existing headline and position properties
+                ;; Don't update the headline text when it already exists
+                ;; Let the user decide how to manage the headlines
+                ;; (org-edit-headline text)
+               (org-hana-notes-set-properties nil beg end props))
+           ;; No headline with the marginal notes ID property. Create a new one
+           ;; at the end of the file's entry
+           (goto-char file-headline)
+           (org-narrow-to-subtree)
+           (goto-char (point-max))
+           ;; Ensure to be in the beginning of line to add a new headline
+           (when (eolp) (open-line 1) (forward-line 1) (beginning-of-line))
+           ;; Create a headline
+           ;; Add a properties
+           (insert (concat "** " text "\n"))
+           (org-hana-notes-set-properties id beg end props)
+          (if (and org-hana-use-org-id orgid)
+              (insert (concat "[[id:" orgid "]" "[" title "]]"))
+            (insert (concat "[[file:" path "]" "[" title "]]"))))))
+      (when (buffer-modified-p) (save-buffer) t))))
+
+(defun org-hana-notes-set-properties (id beg end &optional props)
+  "Set properties for the headline in the notes file.
+Return t.
+
+Minimal properties are:
+
+- org-hana-id :: ID
+- org-hana-source-beg :: BEG
+- org-hana-source-end :: END
+
+For PROPS, if the property name is CATEGORY \(case-sENsiTive\) or
+prefixed with org-hana- set them to to headline's property
+drawer."
+  (when id (org-set-property org-hana-prop-id id))
+  (org-set-property org-hana-prop-source-beg
+                   (number-to-string beg))
+  (org-set-property org-hana-prop-source-end
+                   (number-to-string end))
+  (while props
+    (let ((p (pop props))
+          (v (pop props)))
+      (when (symbolp p) (setq p (symbol-name p)))
+      (when (or (string-equal "CATEGORY" (upcase p))
+                (and (>= (length p) 15)
+                     (string-equal "org-hana-" (downcase (substring p 0 15)))))
+        (org-set-property p v))))
+  t)
+
+(defun org-hana-list-highlights-positions (&optional reverse)
+  "Return list of beg points of highlights in this buffer.
+By default, the list is in ascending order.
+If REVERSE is non-nil, return list in the descending order.
+
+It also checks if the position is visible or not.  Return only
+visible ones.
+
+If none, return nil."
+  (when org-hana-highlights
+    (let ((list org-hana-highlights))
+      (setq list (mapcar
+                  (lambda (h)
+                    (let ((p (overlay-start h)))
+                      ;; Checking if the p is visible or not
+                      (if (or
+                           (> p (point-max))
+                           (< p (point-min))
+                           ;; When the highlight is wihtin a visible folded
+                           ;; area, this function returns 'outline
+                           (org-invisible-p p))
+                          nil p)))
+                  list))
+      (setq list (remove nil list))
+      (when list
+        (if reverse (reverse list) list)))))
+
+(defun org-hana-sort-highlights-list ()
+  "Utility function to sort `org-hana-sort-highlights'.
+It checks if there is any element exists for `org-hana-highlights'.
+Instead of receiving it as an arg, it assumes its existence.  It
+also distructively updates `org-hana-highlights'.
+It returns t when sorting is done."
+  (when org-hana-highlights
+    (setq org-hana-highlights
+         (seq-sort-by (lambda (ov) (overlay-start ov))
+                      #'<
+                      org-hana-highlights))
+    t))
+
+(defun org-hana-find-next-highlight ()
+  "Return the beg point of the next highlight.
+Look through `org-hana-highlights' list."
+  (when-let ((points (org-hana-list-highlights-positions)))
+      ;; Find the first occurance of p > (point). If none, this means all the
+      ;; points occur before the current point. Take the first one. Assume
+      ;; `org-hana-highlights' is sorted in the ascending order (it is).
+    (seq-find (lambda (p) (> p (point))) points (nth 0 points))))
+
+(defun org-hana-find-prev-highlight ()
+  "Return the beg point of the previous highlight.
+Look through `org-hana-highlights' list (in descending order)."
+  (when-let ((points (org-hana-list-highlights-positions 'reverse)))
+      ;; Find the first occurance of p < (point). If none, this means all the
+      ;; points occur before the current point. Take the first one. Assume
+      ;; `org-hana-highlights' is sorted in the descending order .
+    (seq-find (lambda (p) (< p (point))) points (nth 0 points))))
+
+(defun org-hana-hide ()
+  "Hide highlights.
+This function removes the font-lock-face of all the highlights,
+and add org-hana-hidden property with value t. It does not
+check the current hidden state, thus not interactive.  Use
+`org-hana-toggle' command to manually toggle the show/hide
+state."
+  (when-let ((highlights org-hana-highlights))
+    (dolist (highlight highlights)
+      (overlay-put highlight 'face nil)
+      (overlay-put highlight 'org-hana-hidden t))
+    t))
+
+(defun org-hana-show ()
+  "Show highlights.
+This function adds the font-lock-face to all the highlighted text
+regions.  It does not check the current hidden state, thus not
+interactive.  Use `org-hana-toggle' command to manually toggle
+the show/hide state."
+  (when-let ((highlights org-hana-highlights))
+    (dolist (highlight highlights)
+      (overlay-put highlight 'org-hana-hidden nil)
+      ;; TODO it does not work wtih new pens
+      (overlay-put highlight 'face 'org-hana-highlighter))
+    t))
+
+(defun org-hana-remove-single-highlight (id &optional delete-notes)
+  "Remove the highlight entry for ID for current buffer.
+By default, it deletes only the properties of the entry keeping
+the headline intact.  You can pass DELETE-NOTES and delete the
+all notes of the entry."
+  (with-current-buffer (find-file-noselect org-hana-notes-file-path)
+      (org-with-wide-buffer
+       (when-let ((id-headline (org-find-property org-hana-prop-id id)))
+         (goto-char id-headline)
+        (org-narrow-to-subtree)
+         (dolist (prop (org-entry-properties))
+           (when (string-prefix-p "org-hana-" (downcase (car prop)))
+             (org-delete-property (car prop))))
+         ;; Backward compatible
+         (org-delete-property org-hana-prop-id)
+         (org-delete-property org-hana-prop-source-beg)
+         (org-delete-property org-hana-prop-source-end)
+         (when delete-notes
+           ;; TODO I would love to add the y-n prompt if there is any notes 
written
+           (delete-region (point-min)(point-max))
+           (message "Deleted the marginal notes."))
+        (when (buffer-modified-p) (save-buffer))))
+      t))
+
+(defun org-hana-housekeep ()
+  "Housekeep the internal variable `org-hana-highlights'.
+This is a private function; housekeep is automatically done on
+mark, save, and remove -- before sort-highlights.
+
+Case 1. Both start and end of an overlay are identical
+
+        This should not happen when you manually mark a text
+        region.  A typical cause of this case is when you delete a
+        region that contains a highlight overlay.
+
+Case 2. The overlay points to no buffer
+
+        This case happens when overlay is deleted by
+        `overlay-delete' but the variable not cleared."
+  (dolist (ov org-hana-highlights)
+    ;; Both start and end of an overlay are indentical; this should not happen
+    ;; when you manually mark a text region. A typical cause of this case is
+    ;; when you delete a region that contains a highlight overlay.
+    (when (and (overlay-buffer ov)
+              (= (overlay-start ov) (overlay-end ov)))
+      (org-hana-remove-single-highlight (overlay-get ov 'org-hana-id))
+      (delete-overlay ov))
+    (unless (overlay-buffer ov)
+      (setq org-hana-highlights (delete ov org-hana-highlights))))
+  t)
+
+(defun org-hana-empty-buffer-p ()
+  "Return non-nil when the current buffer is empty."
+  (save-excursion
+    (goto-char (point-max))
+    (= 1 (point))))
+
+;;;; Footer
+
+(provide 'org-hana)
+
+;;; org-hana.el ends here
+
+;; Local Variables:
+;; eval: (setq-local org-hana-notes-file-path "README.org")
+;; End:



reply via email to

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