branch: externals/hyperbole
commit 7b6ce90c9b5305d9cca2eefa66e3f30f5383694a
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
Major update to Koutliner data structures; simplified and faster
---
ChangeLog | 52 ++++++++++++++++
Makefile | 10 ++-
kotl/EXAMPLE.kotl | 136 ++++++++++++++++++++--------------------
kotl/MANIFEST | 7 +--
kotl/kcell.el | 175 +++++++++++++++++++++++++++++-----------------------
kotl/kfile.el | 10 +--
kotl/klabel.el | 16 ++---
kotl/knode.el | 92 ---------------------------
kotl/kotl-mode.el | 90 +++++++++++++--------------
kotl/kotl-orgtbl.el | 2 +-
kotl/kprop-em.el | 92 ---------------------------
kotl/kprop-xe.el | 135 ----------------------------------------
kotl/kproperty.el | 95 ++++++++++++++++++++++++++--
kotl/kview.el | 80 +++++++++++++-----------
kotl/kvspec.el | 1 +
15 files changed, 418 insertions(+), 575 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 1e4d460..c076e18 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -12,11 +12,63 @@
* hyrolo.el: Add (require 'xml) and local binding of child used
in google-contacts support.
+* kotl/kotl-mode.el (kotl-mode:move-after): Suppress label increment
+ when label type is permanent ids (fix bug).
+
* kotl/kexport.el (kexport:html-replacement-alist): Change \0
back to \\& to try to fix link replacements again.
+* kotl/kotl-mode.el (kotl-mode:goto-cell): Use prefix arg as a
+ number rather than a string when called interactively.
+
+* kotl/kvspec.el (kvspec:activate): Ensure Koutline is narrowed to
+ editable region only.
+
+* kotl/kview.el (kview:goto-cell-id): Simplify and make much more
+ efficient via kproperty:position call. Allow for integer
+ idstamp argument as well.
+
+* kotl/kcell.el (kcell:ref-to-id): Simplfy using 'when' and
+ 'match-string'; update doc on unimplemented Augment features.
+ Fix to validate that idstamp exists before returning and to
+ convert relative kcell labels to idstamps (integers).
+
+* kotl/kproperty.el (kproperty:position): Add to quickly locate
+ the first kcell with a property value.
+ (kproperty:all-positions): Add to quickly
+ locate all kcells with a property value.
+ (kproperty:add-properties): Add to set
+ multiple properties from a plist.
+ kotl/kcell.el (kcell:is-p):
+ kotl/kview.el (kcell-view:create, kcell-view:set-cell, kview:goto-cell-id):
+ kotl/kfile.el (kfile:insert-attributes-v2, kfile:insert-attributes-v3):
+ Update to use new kcell and kproperty single-level property-list
+ configuration.
+
2021-05-22 Bob Weiner <r...@gnu.org>
+* kotl/kcell.el (kcell:create): Remove contents arg since contents
+ are now stored exclusively in kviews.
+ (kcell:contents): Remove function.
+ (kcell:create-top, kcell-data:create,
+ kcell-data:to-kcell-v2, kcell-data:to-kcell-v3):
+ kotl/kview.el (kview:add-cell):
+ kotl/kotl-mode.el (kotl-mode:copy-after, kotl-mode:copy-before):
+ Use new kcell:create calling convention (no contents arg).
+
+* kotl/kcell.el (kcell:copy, kcell:create, kcell:is-p):
+Delete knode.el and integrate functionality into kcell.el.
+
+* kotl/kcell.el (kcell:get-attr): Alias to plist-get.
+ (kcell:set-attr): Alias to plist-put.
+
+* kotl/kview.el (kcell-view:cell-from-ref): Add to get a kcell from a cell
+ reference (label or idstamp).
+
+* Makefile:
+ kotl/MANIFEST:
+ kotl/kproperty.el: Merge in "kprop-em.el" and remove "kprop-xe.el".
+
* kotl/kexport.el (kexport:html-file-klink): Change '\0' back to
'\\&' to prevent klink nul char insertion bug.
(kexport:html): Fix cell label vertical alignment
diff --git a/Makefile b/Makefile
index fcbd2e1..12548a5 100644
--- a/Makefile
+++ b/Makefile
@@ -163,9 +163,8 @@ EL_COMPILE = hact.el hactypes.el hargs.el hbdata.el
hbmap.el hbut.el \
hui-dired-sidebar.el hypb-maintenance.el
EL_KOTL = kotl/kexport.el kotl/kfile.el kotl/kfill.el kotl/kimport.el
kotl/klabel.el \
- kotl/klink.el kotl/kmenu.el kotl/knode.el kotl/kotl-mode.el
kotl/kotl-orgtbl.el \
- kotl/kcell.el kotl/kproperty.el kotl/kprop-em.el \
- kotl/kview.el kotl/kvspec.el
+ kotl/klink.el kotl/kmenu.el kotl/kotl-mode.el kotl/kotl-orgtbl.el \
+ kotl/kcell.el kotl/kproperty.el kotl/kview.el kotl/kvspec.el
ELC_COMPILE = hactypes.elc hibtypes.elc hib-debbugs.elc hib-doc-id.elc
hib-kbd.elc \
hib-social.elc hact.elc \
@@ -179,9 +178,8 @@ ELC_COMPILE = hactypes.elc hibtypes.elc hib-debbugs.elc
hib-doc-id.elc hib-kbd.
set.elc hypb-ert.elc hui-dired-sidebar.elc hypb-maintenance.elc
ELC_KOTL = kotl/kexport.elc kotl/kfile.elc kotl/kfill.elc kotl/kimport.elc
kotl/klabel.elc \
- kotl/klink.elc kotl/kmenu.elc kotl/knode.elc kotl/kotl-mode.elc
kotl/kotl-orgtbl.elc \
- kotl/kcell.elc kotl/kproperty.elc kotl/kprop-em.elc \
- kotl/kview.elc kotl/kvspec.elc
+ kotl/klink.elc kotl/kmenu.elc kotl/kotl-mode.elc
kotl/kotl-orgtbl.elc \
+ kotl/kcell.elc kotl/kproperty.elc kotl/kview.elc kotl/kvspec.elc
HY-TALK = HY-TALK/.hypb HY-TALK/HYPB HY-TALK/HY-TALK.org
diff --git a/kotl/EXAMPLE.kotl b/kotl/EXAMPLE.kotl
index df1efe6..1f02908 100644
--- a/kotl/EXAMPLE.kotl
+++ b/kotl/EXAMPLE.kotl
@@ -185,7 +185,7 @@
3b13. Cell Identifiers: Permanent ids are associated with each cell
and can be used in hyperlinks that are maintained as cells are
reordered in a file. (These ids may also be displayed in place
- of the outline level relative ids. Use {C-c C-l id RET}.)
+ of the outline level relative ids. Use {C-c C-l id RET}).
Permanent ids are numbered from 0, where 0 is the root node of
the entire outline. This node is never visible within the
outline. Permanent ids always begin with a 0, as in 012, to
@@ -199,7 +199,7 @@
the kcell id to see attributes for all visible cells in the
outline.
- Use {C-c C-i} to add an attribute to or to modify an existing
+ Use {C-c C-i} to add an attribute to or to modify an existing
attribute of the cell at point.
3b15. File Insertion: The elements of another buffer or file may be
@@ -254,7 +254,7 @@
koutline buffer or file to create.
3b16c. Augment Files Numbered on the Right-Side: (Skip this if you are
- unfamiliar with this sort of file.) Files exported from the
+ unfamiliar with this sort of file). Files exported from the
Augment system as text often have alphanumeric statement
identifiers on the right side.
@@ -317,7 +317,7 @@
3c1a. <@ 3b=06> jumps to the cell within this outline which has
permanent id `06' and relative id `3b'. <@ 06> does the same
- thing, as does <@ 2b>, though this latter form will not
+ thing, as does <@ 3b>, though this latter form will not
maintain the link properly if the cell is moved elsewhere
within the outline.
@@ -360,7 +360,7 @@
4f. Flexible view handling has been only partially implemented.
-"bn" ;; kvspec:current
+"ben" ;; kvspec:current
77 ;; id-counter
alpha ;; label-type
3 ;; label-min-width
@@ -369,127 +369,127 @@ alpha ;; label-type
;; depth-first kcell attributes
[[0
- (creator "r...@gnu.org" create-time "20210510:04:09:59" id-counter 77 file
"/Users/bk/Dropbox/emacs/hyperbole/kotl/EXAMPLE.kotl")]
+ (idstamp 0 creator "bw@NYC-WEINERBOB" create-time "20210524:02:30:42"
id-counter 77 file
"/mnt/c/Users/bob.weiner/Dropbox/emacs/hyperbole/kotl/EXAMPLE.kotl")]
[20
- (creator "r...@gnu.org" create-time "19940104:17:38:28" no-fill t)]
- [75
- (idstamp 20 creator "r...@gnu.org" create-time "19940104:17:38:28" no-fill
t)]
+ (rear-nonsticky t no-fill t create-time "19940104:17:38:28" creator
"r...@gnu.org" idstamp 20 kcell t)]
+ [2
+ (rear-nonsticky t no-fill t create-time "19940104:17:38:28" creator
"r...@gnu.org" idstamp 2 kcell t)]
[34
- (creator "r...@gnu.org" create-time "19940610:16:43:55")]
+ (rear-nonsticky t create-time "19940610:16:43:55" creator "r...@gnu.org"
idstamp 34 kcell t)]
[35
- (creator "r...@gnu.org" create-time "19940610:16:44:03")]
+ (rear-nonsticky t create-time "19940610:16:44:03" creator "r...@gnu.org"
idstamp 35 kcell t)]
[4
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 4 kcell t)]
[5
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 5 kcell t)]
[6
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 6 kcell t)]
[14
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 14 kcell t)]
[67
- (creator "r...@gnu.org" create-time "19951028:04:29:13" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951028:04:29:13" creator
"r...@gnu.org" idstamp 67 kcell t)]
[15
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 15 kcell t)]
[31
- (creator "r...@gnu.org" create-time "19940306:18:11:43")]
+ (rear-nonsticky t create-time "19940306:18:11:43" creator "r...@gnu.org"
idstamp 31 kcell t)]
[7
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 7 kcell t)]
[46
- (creator "r...@gnu.org" create-time "19950614:21:35:17")]
+ (rear-nonsticky t create-time "19950614:21:35:17" creator "r...@gnu.org"
idstamp 46 kcell t)]
[43
- (creator "r...@gnu.org" create-time "19940610:22:00:46")]
+ (rear-nonsticky t create-time "19940610:22:00:46" creator "r...@gnu.org"
idstamp 43 kcell t)]
[22
- (creator "r...@gnu.org" create-time "19940127:22:41:42")]
+ (rear-nonsticky t create-time "19940127:22:41:42" creator "r...@gnu.org"
idstamp 22 kcell t)]
[32
- (creator "r...@gnu.org" create-time "19940610:16:31:28")]
+ (rear-nonsticky t create-time "19940610:16:31:28" creator "r...@gnu.org"
idstamp 32 kcell t)]
[41
- (creator "r...@gnu.org" create-time "19940610:18:55:09")]
+ (rear-nonsticky t create-time "19940610:18:55:09" creator "r...@gnu.org"
idstamp 41 kcell t)]
[42
- (creator "r...@gnu.org" create-time "19940610:18:55:57")]
+ (rear-nonsticky t create-time "19940610:18:55:57" creator "r...@gnu.org"
idstamp 42 kcell t)]
[33
- (creator "r...@gnu.org" create-time "19940610:16:31:29")]
+ (rear-nonsticky t create-time "19940610:16:31:29" creator "r...@gnu.org"
idstamp 33 kcell t)]
[47
- (creator "r...@gnu.org" create-time "19951022:22:59:26" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951022:22:59:26" creator
"r...@gnu.org" idstamp 47 kcell t)]
[8
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 8 kcell t)]
[28
- (creator "r...@gnu.org" create-time "19940128:22:50:44")]
+ (rear-nonsticky t create-time "19940128:22:50:44" creator "r...@gnu.org"
idstamp 28 kcell t)]
[29
- (creator "r...@gnu.org" create-time "19940128:22:50:54")]
+ (rear-nonsticky t create-time "19940128:22:50:54" creator "r...@gnu.org"
idstamp 29 kcell t)]
[10
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 10 kcell t)]
[30
- (creator "r...@gnu.org" create-time "19940129:00:27:59")]
+ (rear-nonsticky t create-time "19940129:00:27:59" creator "r...@gnu.org"
idstamp 30 kcell t)]
[62
- (creator "r...@gnu.org" create-time "19951026:08:32:57" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951026:08:32:57" creator
"r...@gnu.org" idstamp 62 kcell t)]
[70
- (creator "r...@gnu.org" create-time "19951030:19:18:49" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951030:19:18:49" creator
"r...@gnu.org" idstamp 70 kcell t)]
[71
- (creator "r...@gnu.org" create-time "19951030:19:19:40" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951030:19:19:40" creator
"r...@gnu.org" idstamp 71 kcell t)]
[73
- (creator "r...@gnu.org" create-time "19951030:19:23:09" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951030:19:23:09" creator
"r...@gnu.org" idstamp 73 kcell t)]
[63
- (creator "r...@gnu.org" create-time "19951026:19:31:34" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951026:19:31:34" creator
"r...@gnu.org" idstamp 63 kcell t)]
[64
- (creator "r...@gnu.org" create-time "19951026:19:33:01" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951026:19:33:01" creator
"r...@gnu.org" idstamp 64 kcell t)]
[69
- (creator "r...@gnu.org" create-time "19951029:06:24:35" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951029:06:24:35" creator
"r...@gnu.org" idstamp 69 kcell t)]
[68
- (creator "r...@gnu.org" create-time "19951029:06:24:27" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951029:06:24:27" creator
"r...@gnu.org" idstamp 68 kcell t)]
[65
- (creator "r...@gnu.org" create-time "19951026:19:33:08" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951026:19:33:08" creator
"r...@gnu.org" idstamp 65 kcell t)]
[66
- (creator "r...@gnu.org" create-time "19951026:19:33:15" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951026:19:33:15" creator
"r...@gnu.org" idstamp 66 kcell t)]
[77
- (creator "r...@gnu.org" create-time "19980226:19:54:44" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19980226:19:54:44" creator
"r...@gnu.org" idstamp 77 kcell t)]
[48
- (creator "r...@gnu.org" create-time "19951023:05:55:19" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:05:55:19" creator
"r...@gnu.org" idstamp 48 kcell t)]
[57
- (creator "r...@gnu.org" create-time "19951023:10:07:06" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:10:07:06" creator
"r...@gnu.org" idstamp 57 kcell t)]
[58
- (creator "r...@gnu.org" create-time "19951023:10:07:26" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:10:07:26" creator
"r...@gnu.org" idstamp 58 kcell t)]
[49
- (creator "r...@gnu.org" create-time "19951023:05:55:55" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:05:55:55" creator
"r...@gnu.org" idstamp 49 kcell t)]
[55
- (creator "r...@gnu.org" create-time "19951023:08:56:41" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:08:56:41" creator
"r...@gnu.org" idstamp 55 kcell t)]
[50
- (creator "r...@gnu.org" create-time "19951023:05:57:26" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:05:57:26" creator
"r...@gnu.org" idstamp 50 kcell t)]
[51
- (creator "r...@gnu.org" create-time "19951023:05:58:31" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:05:58:31" creator
"r...@gnu.org" idstamp 51 kcell t)]
[56
- (creator "r...@gnu.org" create-time "19951023:08:57:09" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:08:57:09" creator
"r...@gnu.org" idstamp 56 kcell t)]
[52
- (creator "r...@gnu.org" create-time "19951023:05:59:59" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:05:59:59" creator
"r...@gnu.org" idstamp 52 kcell t)]
[53
- (creator "r...@gnu.org" create-time "19951023:06:00:48" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:06:00:48" creator
"r...@gnu.org" idstamp 53 kcell t)]
[54
- (creator "r...@gnu.org" create-time "19951023:06:05:50" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951023:06:05:50" creator
"r...@gnu.org" idstamp 54 kcell t)]
[26
- (creator "r...@gnu.org" create-time "19940128:03:56:23")]
+ (rear-nonsticky t create-time "19940128:03:56:23" creator "r...@gnu.org"
idstamp 26 kcell t)]
[27
- (creator "r...@gnu.org" create-time "19940128:22:36:54")]
+ (rear-nonsticky t create-time "19940128:22:36:54" creator "r...@gnu.org"
idstamp 27 kcell t)]
[59
- (creator "r...@gnu.org" create-time "19951024:03:40:05" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951024:03:40:05" creator
"r...@gnu.org" idstamp 59 kcell t)]
[60
- (creator "r...@gnu.org" create-time "19951024:03:40:13" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951024:03:40:13" creator
"r...@gnu.org" idstamp 60 kcell t)]
[61
- (creator "r...@gnu.org" create-time "19951024:03:40:42" no-fill t)]
+ (rear-nonsticky t no-fill t create-time "19951024:03:40:42" creator
"r...@gnu.org" idstamp 61 kcell t)]
[1
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 1 kcell t)]
[11
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 11 kcell t)]
[12
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 12 kcell t)]
[44
- (creator "r...@gnu.org" create-time "19940728:21:56:49")]
+ (rear-nonsticky t create-time "19940728:21:56:49" creator "r...@gnu.org"
idstamp 44 kcell t)]
[36
- (creator "r...@gnu.org" create-time "19940610:16:49:34")]
+ (rear-nonsticky t create-time "19940610:16:49:34" creator "r...@gnu.org"
idstamp 36 kcell t)]
[37
- (creator "r...@gnu.org" create-time "19940610:16:50:02")]
+ (rear-nonsticky t create-time "19940610:16:50:02" creator "r...@gnu.org"
idstamp 37 kcell t)]
[38
- (creator "r...@gnu.org" create-time "19940610:16:50:13")]
+ (rear-nonsticky t create-time "19940610:16:50:13" creator "r...@gnu.org"
idstamp 38 kcell t)]
[13
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 13 kcell t)]
[16
- (creator "r...@gnu.org" create-time "19940104:17:38:29")]
+ (rear-nonsticky t create-time "19940104:17:38:29" creator "r...@gnu.org"
idstamp 16 kcell t)]
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil]
diff --git a/kotl/MANIFEST b/kotl/MANIFEST
index 454c746..473ef2b 100644
--- a/kotl/MANIFEST
+++ b/kotl/MANIFEST
@@ -8,11 +8,8 @@ kimport.el - Convert and insert other outline
file formats into koutlines
klabel.el - Display label handling for koutlines
klink.el - Implicit reference to a kcell action type, for use
in koutlines
kmenu.el - Pulldown and popup menus for kotl-mode, the
Koutliner mode
-knode.el - Generic nodes for use as elements in data
structures
kotl-mode.el - Major mode for editing koutlines and associated
commands
-kotl-orgtbl.el - Allow use of Org minor-mode table editing in
Koutlines
-kproperty.el - Wrapper for koutline text property implementations
-kprop-em.el - Koutline text property handling under GNU Emacs
-kprop-xe.el - Koutline text property handling under XEmacs
+kotl-orgtbl.el - Allow use of Org minor-mode table editing in
koutlines
+kproperty.el - Kcell in-buffer property handling for the Koutliner
kview.el - Display handling of koutlines
kvspec.el - Koutline view specification
diff --git a/kotl/kcell.el b/kotl/kcell.el
index e6a06df..0e8ed17 100644
--- a/kotl/kcell.el
+++ b/kotl/kcell.el
@@ -12,15 +12,15 @@
;;; Commentary:
;;
;; Defines kcells, nodes in Koutlines, along with a persistent representation
-;; for writing to files called kcell-data.
-;;
+;; called kcell-data for writing to files. Node text content is stored
+;; separately in kview for efficiency.
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
-(eval-and-compile (mapc #'require '(hinit htz klabel knode kview)))
+(eval-and-compile (mapc #'require '(hinit htz klabel kview)))
;;; ************************************************************************
;;; Public variables
@@ -39,102 +39,131 @@ Add to this list but don't remove any of the default
elements.")
;;; kcell
;;;
-(defalias 'kcell:contents 'knode:contents)
-
(defun kcell:copy (kcell)
"Return a copy of KCELL."
- (knode:copy kcell))
+ (copy-tree kcell))
-(defun kcell:create (contents idstamp &optional plist)
- "Return a new kcell which store CONTENTS (a string or nil), has permanent
IDSTAMP (an integer), and optional additional property list, PLIST.
+(defun kcell:create (idstamp &optional plist)
+ "Return a new kcell which has permanent IDSTAMP (an integer) and optional
additional property list, PLIST.
User id of `creator' of cell and `create-time' are added to cell's PLIST if
not already there."
- (and contents (not (stringp contents))
- (error "(kcell:create): Invalid `contents' argument: %s" contents))
(unless (klabel:idstamp-p idstamp)
- (error "(kcell:create): Invalid `idstamp' argument: %s" idstamp))
- (knode:create
- contents (nconc (list 'idstamp idstamp)
- (if (memq 'creator plist)
- nil
- (list 'creator hyperb:user-email
- 'create-time (htz:date-sortable-gmt)))
- plist)))
+ (error "(kcell:create): Invalid `idstamp' argument: '%s'" idstamp))
+ (nconc
+ (list 'kcell t)
+ (list 'idstamp idstamp)
+ (unless (memq 'creator plist)
+ (list 'creator hyperb:user-email
+ 'create-time (htz:date-sortable-gmt)))
+ plist))
(defun kcell:create-top (&optional file counter)
"Return a new koutline top cell optionally attached to FILE with current
idstamp COUNTER."
- (kcell:create nil 0
+ (kcell:create 0
;; id-counter = max idstamp value given out in this koutline
(list 'id-counter (or counter 0) 'file file)))
-(defun kcell:get-attr (kcell attribute)
- "Return the value of KCELL's ATTRIBUTE."
- (knode:get-attr (kcell:plist kcell) attribute))
+(defalias 'kcell:get-attr 'plist-get)
(defun kcell:idstamp (kcell)
"Return permanent idstamp of KCELL as an integer."
(kcell:get-attr kcell 'idstamp))
-(defalias 'kcell:is-p 'knode:is-p)
+(defun kcell:is-p (object)
+ "Is OBJECT a kcell?"
+ (and (listp object) (plist-get object 'kcell)))
-(defun kcell:plist (kcell)
- (knode:get-attr kcell 'plist))
+(defalias 'kcell:plist 'identity)
(defun kcell:ref-to-id (cell-ref)
- "Return a CELL-REF string converted to a cell identifier string.
+ "When CELL-REF is valid, return a CELL-REF string converted to a cell
idstamp (integer).
If CELL-REF contains both a relative and a permanent id, the permanent id is
returned. If CELL-REF is invalid, nil is returned.
-CELL-REF may be of any of the following forms:
- 1b - relative id, augment style
+CELL-REF may be a whole number:
+
+ 12 - permanent idstamp
+
+or any of the following string forms:
+ 1 or 1b - relative id, augment style
1.2 - relative id, legal style
012 - permanent idstamp
1a=012 - both relative and permanent ids (in that order) separated by =
|viewspec - a viewspec setting, rather than a cell reference
:viewspec - an augment viewspec, ignored for now.
-Optionally, any of the above id forms may be followed by a period and some
-alpha characters indicating a location relative to the id.
-
Optionally, any of these id forms (or the relative form) may be followed by
zero or more whitespace characters, a | and some view specification
-characters. Augment viewspec characters preceded by a colon are ignored, for
-now."
-
- (if (not (stringp cell-ref))
- nil
- (setq cell-ref (hypb:replace-match-string "\\s +" cell-ref "" t))
- (let ((specs) result)
- ;; Ignore Augment :viewspecs.
- (if (string-match ":" cell-ref)
- (setq cell-ref (substring cell-ref 0 (match-beginning 0))))
- ;; Separate koutline |viewspecs from cell id.
- (if (string-match "\\(\\.[a-zA-Z]\\||\\)" cell-ref)
- (setq specs (substring cell-ref (match-beginning 1))
- cell-ref (substring cell-ref 0 (match-beginning 0))))
- (setq result
- (cond
- ((string-match "[^.= \t\n\r\f0-9a-zA-Z]" cell-ref) nil)
- ((string-match "^\\([.0-9a-zA-Z]+\\)=\\(0[0-9]*\\)$"
- cell-ref)
- (substring cell-ref (match-beginning 2) (match-end 2)))
- ((string-match "^\\([.0-9a-zA-Z]+\\)$" cell-ref)
- (substring cell-ref (match-beginning 1) (match-end 1)))))
- (cond (result
- (if specs (concat result specs) result))
- (specs
- (if (eq ?| (aref specs 0)) specs))))))
+characters.
+
+Augment capabilities not yet implemented and ignored for now:
+ 1. Augment viewspec characters preceded by a colon
+ 2. Any of the above id forms followed by a period and some
+ alpha characters indicating a location relative to the id."
+ (cond ((integerp cell-ref)
+ (when (kproperty:position 'idstamp cell-ref)
+ cell-ref))
+ ((stringp cell-ref)
+ (setq cell-ref (hypb:replace-match-string "\\s-+" cell-ref "" t))
+ (let (specs
+ result)
+ ;; Ignore Augment :viewspecs.
+ (when (string-match ":" cell-ref)
+ (setq cell-ref (substring cell-ref 0 (match-beginning 0))))
+ ;; Separate koutline |viewspecs from cell id.
+ (when (string-match "\\(\\.[a-zA-Z]\\||\\)" cell-ref)
+ (setq specs (substring cell-ref (match-beginning 1))
+ cell-ref (substring cell-ref 0 (match-beginning 0))))
+ (setq result
+ (cond
+ ((string-match "[^.= \t\n\r\f0-9a-zA-Z]" cell-ref) nil)
+ ((or (string-match "^\\([.0-9a-zA-Z]+\\)=\\(0[0-9]*\\)$"
+ cell-ref)
+ ;; idstamp only
+ (string-match "^\\(\\)\\(0[0-9]*\\)$" cell-ref))
+ (setq result (string-to-number (match-string 2 cell-ref)))
+ ;; Validate that idstamp value exists, else return nil
+ (when (kproperty:position 'idstamp result)
+ result))
+ ((string-match "^\\([.0-9a-zA-Z]+\\)$" cell-ref)
+ ;; relative label
+ (setq result (match-string 1 cell-ref))
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^[ \t]*" (regexp-quote
result)
+ (regexp-quote
(kview:label-separator kview)))
+ nil t)
+
+ (setq result (string-to-number (kcell-view:idstamp)))
+ ;; Validate that idstamp value exists, else return nil
+ (when (kproperty:position 'idstamp result)
+ result))))))
+ (cond (result
+ (if specs (concat result specs) result))
+ (specs
+ (when (eq ?| (aref specs 0)) specs)))))))
(defun kcell:remove-attr (kcell attribute)
- "Remove KCELL's ATTRIBUTE, if any, return modified KCELL."
- (knode:set-attr
- kcell 'plist (knode:remove-attr (kcell:plist kcell) attribute)))
-
-(defun kcell:set-attr (kcell attribute value)
- "Set KCELL's ATTRIBUTE to VALUE and return modified KCELL."
- (knode:set-attr
- kcell 'plist (knode:set-attr (kcell:plist kcell)
- attribute value)))
+ "Remove KCELL's ATTRIBUTE, if any, and return modified KCELL."
+ (let ((tail kcell)
+ sym
+ prev)
+ (setq sym (car tail))
+ (while (and sym (eq sym attribute))
+ (setq tail (cddr tail)
+ sym (car tail)))
+ (setq kcell tail
+ prev tail
+ tail (cddr tail))
+ (while tail
+ (setq sym (car tail))
+ (if (eq sym attribute)
+ (setcdr (cdr prev) (cddr tail)))
+ (setq prev tail
+ tail (cddr tail)))
+ kcell))
+
+(defalias 'kcell:set-attr 'plist-put)
(defun kcell:set-create-time (kcell)
"Store the time of creation of KCELL."
@@ -162,7 +191,7 @@ assuming it is the cell at point and filling in the missing
information."
(if (and cell idstamp plist)
(vector idstamp plist)
(kcell-data:create
- (kcell:create nil (or idstamp (kview:id-increment kview)) plist)))))
+ (kcell:create (or idstamp (kview:id-increment kview)) plist)))))
(defun kcell-data:idstamp (kcell-data)
(aref kcell-data 0))
@@ -176,28 +205,20 @@ assuming it is the cell at point and filling in the
missing information."
(defun kcell-data:to-kcell-v2 (kcell-data)
(if (vectorp kcell-data)
(kcell:create
- ;; Cell contents are no longer put into cells themselves by default
- ;; when a file is read. The contents are stored within the kview
- ;; buffer, so use nil as a place-holder.
- nil
;; Repair invalid idstamps on the fly.
(or (kcell-data:idstamp kcell-data) (kview:id-increment kview))
(kcell-data:plist-v2 kcell-data))
;; Repair invalid cells on the fly.
- (kcell:create nil (kview:id-increment kview))))
+ (kcell:create (kview:id-increment kview))))
(defun kcell-data:to-kcell-v3 (kcell-data)
(if (vectorp kcell-data)
(kcell:create
- ;; Cell contents are no longer put into cells themselves by default
- ;; when a file is read. The contents are stored within the kview
- ;; buffer, so use nil as a place-holder.
- nil
;; Repair invalid idstamps on the fly.
(or (kcell-data:idstamp kcell-data) (kview:id-increment kview))
(kcell-data:plist-v3 kcell-data))
;; Repair invalid cells on the fly.
- (kcell:create nil (kview:id-increment kview))))
+ (kcell:create (kview:id-increment kview))))
(provide 'kcell)
diff --git a/kotl/kfile.el b/kotl/kfile.el
index 80b8ab0..ee248d8 100644
--- a/kotl/kfile.el
+++ b/kotl/kfile.el
@@ -59,7 +59,8 @@ Return the new kview."
;; again.
(unless (kview:is-p kview)
(kfile:read buffer existing-file))
- (or (eq major-mode 'kotl-mode) (kotl-mode))
+ (unless (derived-mode-p 'kotl-mode)
+ (kotl-mode))
kview))
;;;###autoload
@@ -398,7 +399,7 @@ hidden."
;; Be sure not to skip past a period which may terminate the label.
(if (re-search-forward "[A-Za-z0-9]\\(\\.?[A-Za-z0-9]\\)*" nil t)
(progn
- (kproperty:set 'kcell (car kcell-list))
+ (kproperty:add-properties (car kcell-list))
(setq kcell-list (cdr kcell-list))))
(search-forward "\n\n" nil t)))))
@@ -417,9 +418,8 @@ hidden."
;; Be sure not to skip past a period which may terminate the label.
(if (re-search-forward "[A-Za-z0-9]\\(\\.?[A-Za-z0-9]\\)*" nil t)
(progn
- (kproperty:set 'kcell
- (kcell-data:to-kcell-v3
- (aref kcell-vector kcell-num)))
+ (kproperty:add-properties
+ (kcell-data:to-kcell-v3 (aref kcell-vector kcell-num)))
(setq kcell-num (1+ kcell-num))))
(search-forward "\n\n" nil t)))))
diff --git a/kotl/klabel.el b/kotl/klabel.el
index 96f9d41..5ba3a5c 100644
--- a/kotl/klabel.el
+++ b/kotl/klabel.el
@@ -478,13 +478,13 @@ and the start of its contents."
CURRENT-CELL-LABEL is the label to display for the current cell.
If, however, it is \"0\", then all cell labels are updated."
(let ((label-type (kview:label-type kview)))
- (if (memq label-type '(alpha legal partial-alpha))
- (if (string-equal current-cell-label "0")
- ;; Update all cells in view.
- (klabel-type:set-labels label-type)
- ;; Update current tree and its siblings only.
- (klabel-type:update-labels-from-point
- label-type current-cell-label)))))
+ (when (memq label-type '(alpha legal partial-alpha))
+ (if (string-equal current-cell-label "0")
+ ;; Update all cells in view.
+ (klabel-type:set-labels label-type)
+ ;; Update current tree and its siblings only.
+ (klabel-type:update-labels-from-point
+ label-type current-cell-label)))))
(defun klabel-type:update-tree-labels (current-cell-label first-label)
"Update the labels of current cell and its subtree.
@@ -572,7 +572,7 @@ For example, \"14\" would become \"15\"."
(defun kotl-label:integer-p (label)
"Return LABEL iff LABEL is composed of all digits, else return nil."
- (if (string-match "\\`[0-9]+\\'" label) label))
+ (when (string-match "\\`[0-9]+\\'" label) label))
;; This handles partial alphabetic labels with a maximum single level
;; sequence of 17575 items, which = (1- (expt 26 3)), after which it gives
diff --git a/kotl/knode.el b/kotl/knode.el
deleted file mode 100644
index ee06201..0000000
--- a/kotl/knode.el
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; knode.el --- Generic nodes for use as elements in data structures
-;;
-;; Author: Bob Weiner
-;;
-;; Orig-Date: 5/1/93
-;;
-;; Copyright (C) 1993-2016 Free Software Foundation, Inc.
-;; See the "../HY-COPY" file for license information.
-;;
-;; This file is part of GNU Hyperbole.
-
-;;; Commentary:
-
-;;; Code:
-;;; ************************************************************************
-;;; Public functions
-;;; ************************************************************************
-
-;;;
-;;; Knodes
-;;;
-
-(defun knode:create (contents &optional prop-list)
- "Return a new knode which store CONTENTS and optional PROP-LIST."
- (list 'knode
- 'contents contents
- 'plist prop-list))
-
-(defun knode:contents (knode)
- "Return KNODE's contents."
- (if (knode:is-p knode)
- (car (cdr (memq 'contents knode)))
- (error "(knode:contents): Argument must be a knode")))
-
-(defalias 'knode:copy 'copy-tree)
-
-(defun knode:is-p (object)
- "Is OBJECT a knode?"
- (and (listp object) (eq (car object) 'knode)))
-
-(defun knode:set-contents (knode contents)
- "Set KNODE's CONTENTS."
- (if (knode:is-p knode)
- (setcar (cdr (memq 'contents knode)) contents)
- (error "(knode:set-contents): First arg must be a knode")))
-
-;;; ************************************************************************
-;;; Private functions
-;;; ************************************************************************
-
-(defun knode:get-attr (obj attribute)
- "Return the value of OBJ's ATTRIBUTE."
- (car (cdr (memq attribute obj))))
-
-(defun knode:remove-attr (obj attribute)
- "Remove OBJ's ATTRIBUTE, if any, and return modified OBJ.
-Use (setq object (knode:remove-attr object attribute)) to ensure that OBJ
-is updated."
- (let ((tail obj)
- sym
- prev)
- (setq sym (car tail))
- (while (and sym (eq sym attribute))
- (setq tail (cdr (cdr tail))
- sym (car tail)))
- (setq obj tail
- prev tail
- tail (cdr (cdr tail)))
- (while tail
- (setq sym (car tail))
- (if (eq sym attribute)
- (setcdr (cdr prev) (cdr (cdr tail))))
- (setq prev tail
- tail (cdr (cdr tail))))
- obj))
-
-(defun knode:set-attr (obj attribute value)
- "Set OBJ's ATTRIBUTE to VALUE and return OBJ."
- (let ((attr (memq attribute obj)))
- (if attr
- (setcar (cdr attr) value)
- (setq obj (nconc obj (list attribute value)))))
- obj)
-
-;;; ************************************************************************
-;;; Private variables
-;;; ************************************************************************
-
-(provide 'knode)
-
-
-;;; knode.el ends here
diff --git a/kotl/kotl-mode.el b/kotl/kotl-mode.el
index 722cbcb..8363c32 100644
--- a/kotl/kotl-mode.el
+++ b/kotl/kotl-mode.el
@@ -208,7 +208,7 @@ Hyperbole EXAMPLE."
(unless (stringp example)
(setq example "EXAMPLE.kotl"))
(when (file-directory-p example)
- (setq personal-example (expand-file-name "EXAMPLE.kotl" example )
+ (setq personal-example (expand-file-name "EXAMPLE.kotl" example)
example "EXAMPLE.kotl"))
(unless personal-example
(if (file-name-absolute-p example)
@@ -961,7 +961,7 @@ Goes backward if ARG is negative; error if CHAR not found."
;;; ------------------------------------------------------------------------
(defun kotl-mode:append-cell (contents-cell append-to-cell)
- "Append CONTENTS-CELL to APPEND-TO-CELL.
+ "Append CONTENTS-CELL (a cell ref) to APPEND-TO-CELL (a cell ref).
APPEND-TO-CELL is refilled if neither cell has a no-fill property and
kotl-mode:refill-flag is enabled."
(interactive
@@ -1014,7 +1014,7 @@ Leave point at the start of the root cell of the new
tree."
(kview:map-tree
(lambda (view)
(kcell-view:set-cell
- (kcell:create nil (kview:id-increment view))))
+ (kcell:create (kview:id-increment view))))
kview))
(defun kotl-mode:copy-before (from-cell-ref to-cell-ref parent-p)
@@ -1040,7 +1040,7 @@ Leave point at the start of the root cell of the new
tree."
(kview:map-tree
(lambda (view)
(kcell-view:set-cell
- (kcell:create nil (kview:id-increment view))))
+ (kcell:create (kview:id-increment view))))
kview))
(defun kotl-mode:copy-to-buffer (cell-ref buffer invisible-flag)
@@ -1107,6 +1107,7 @@ Leave point at original location but return the tree's
new start point."
(end (kotl-mode:tree-end))
(sib-id (if (= 0 (kotl-mode:forward-cell 1))
(kcell-view:idstamp)))
+ (id-label-flag (eq (kview:label-type kview) 'id))
new-tree-start)
;;
;; We can't move a tree to a point within itself, so if that is the case
@@ -1119,10 +1120,10 @@ Leave point at original location but return the tree's
new start point."
;; sibling cell. Mark its label with a property which will be deleted
;; whenever the cell label is renumbered. This tells us whether or not
;; to renumber the sibling separately from the tree to move.
- (if sib-id
- ;; Move to middle of label and insert klabel-original temp property.
- (progn (goto-char (- (point) label-sep-len 3))
- (kproperty:set 'klabel-original t)))
+ (when sib-id
+ ;; Move to middle of label and insert klabel-original temp property.
+ (goto-char (- (point) label-sep-len 3))
+ (kproperty:set 'klabel-original t))
;;
;; Position for insertion before deletion of tree-to-move from old
;; position, in case old position precedes new one.
@@ -1135,7 +1136,8 @@ Leave point at original location but return the tree's
new start point."
to-indent (+ to-indent (kview:level-indent kview))))
;; Move to after to-cell-ref's tree for insertion as following sibling.
(goto-char (kotl-mode:tree-end))
- (setq to-label (klabel:increment to-label)))
+ (unless id-label-flag
+ (setq to-label (klabel:increment to-label))))
;;
;; Insert tree-to-move at new location
;;
@@ -1153,13 +1155,13 @@ Leave point at original location but return the tree's
new start point."
;;
;; Move to sibling of tree-to-move within view and update labels within
;; view of tree-to-move's original siblings.
- (if sib-id
- (progn (kotl-mode:goto-cell sib-id t)
- ;; Sibling labels may have already been updated if tree was
- ;; moved somewhere preceding its siblings.
- (let ((label-middle (- (point) label-sep-len 2)))
- (if (kproperty:get label-middle 'klabel-original)
- (klabel-type:update-labels from-label))))))
+ (when sib-id
+ (kotl-mode:goto-cell sib-id t)
+ ;; Sibling labels may have already been updated if tree was
+ ;; moved somewhere preceding its siblings.
+ (let ((label-middle (- (point) label-sep-len 2)))
+ (when (kproperty:get label-middle 'klabel-original)
+ (klabel-type:update-labels from-label)))))
;;
(goto-char new-tree-start)
;;
@@ -1731,7 +1733,7 @@ CELL-REF is not found within current view. Will signal
same
error if called interactively when CELL-REF is not found."
(interactive
(list (if current-prefix-arg
- (format "0%d" (prefix-numeric-value current-prefix-arg))
+ (prefix-numeric-value current-prefix-arg)
(read-string "Goto cell label or id: "))))
(setq cell-ref
(or (kcell:ref-to-id cell-ref)
@@ -1739,39 +1741,33 @@ error if called interactively when CELL-REF is not
found."
(let* ((opoint (point))
(found)
cell-id kvspec)
- (if (eq ?| (aref cell-ref 0))
+ (if (and (stringp cell-ref) (eq ?| (aref cell-ref 0)))
;; This is a standalone view spec, not a cell reference.
(progn (kvspec:activate cell-ref) (setq found (point)))
- ;; !! Remove any relative specs and view specs from
- ;; cell-ref to form cell-id. Really should account for relative
- ;; specs here, but we don't yet support them.
- (if (string-match "\\(\\.[a-zA-Z]+\\)?\\([|:].*\\)\\|\\.[a-zA-Z]+"
- cell-ref)
+ ;; !! Todo: Remove any relative specs and view specs from
+ ;; cell-ref to form cell-id. Really should account for Augment-style
+ ;; relative specs here, but we don't yet support them.
+ (if (and (stringp cell-ref)
+ (string-match "\\(\\.[a-zA-Z]+\\)?\\([|:].*\\)\\|\\.[a-zA-Z]+"
+ cell-ref))
(setq cell-id (substring cell-ref 0 (match-beginning 0))
kvspec (when (match-beginning 2)
- (substring cell-ref (match-beginning 2) (match-end
2))))
+ (match-string 2 cell-ref)))
(setq cell-id cell-ref kvspec nil))
(goto-char (point-min))
- (cond ((eq ?0 (aref cell-id 0))
- ;; is an idstamp
- (when (kview:goto-cell-id cell-id)
- (setq found (point))))
- ;; is a label
- ((re-search-forward
- (format "\\([\n\r][\n\r]\\|\\`\\)[ ]*%s%s"
- (regexp-quote cell-id)
- (regexp-quote (kview:label-separator kview)))
- nil t)
- (setq found (point)))
- ;; no match
- (t (goto-char opoint)
- nil))
- (if (and (not found) (or error-p (called-interactively-p 'interactive)))
- (error "(kotl-mode:goto-cell): No `%s' cell in this view" cell-ref)
- ;; Activate any viewspec associated with cell-ref.
- (when kvspec (kvspec:activate kvspec))))
+ (when (or (integerp cell-id)
+ (eq ?0 (aref cell-id 0)))
+ ;; is an idstamp
+ (when (kview:goto-cell-id cell-id)
+ (setq found (point))))
+ (if found
+ ;; Activate any viewspec associated with cell-ref.
+ (when kvspec (kvspec:activate kvspec))
+ (goto-char opoint)
+ (when (or error-p (called-interactively-p 'interactive))
+ (error "(kotl-mode:goto-cell): No `%s' cell in this view" cell-ref))))
found))
(defun kotl-mode:head-cell ()
@@ -2135,9 +2131,13 @@ If assist-key is pressed:
(defun kotl-mode:add-cell (&optional relative-level contents plist no-fill)
"Add a cell following current cell at optional RELATIVE-LEVEL with CONTENTS
string, attributes in PLIST, a property list, and NO-FILL flag to prevent any
filling of CONTENTS.
-Optional prefix arg RELATIVE-LEVEL means add as sibling if nil or >= 0, as
-child if equal to universal argument, {C-u}, and as sibling of current cell's
-parent, otherwise. If added as sibling of current level, RELATIVE-LEVEL is
+Optional prefix arg RELATIVE-LEVEL means either:
+
+ 1. add as the next sibling if nil or >= 0;
+ 2. as the first child if equal to '(4), given by the universal argument,
{C-u};
+ 3. otherwise, as the first sibling of the current cell's parent.
+
+If added as the next sibling of the current level, then RELATIVE-LEVEL is
used as a repeat count for the number of cells to add.
Return last newly added cell."
diff --git a/kotl/kotl-orgtbl.el b/kotl/kotl-orgtbl.el
index 7ae9a00..a1632ad 100644
--- a/kotl/kotl-orgtbl.el
+++ b/kotl/kotl-orgtbl.el
@@ -1,4 +1,4 @@
-;;; kotl-orgtbl.el --- Allow use of Org minor-mode table editing in Koutlines
+;;; kotl-orgtbl.el --- Allow use of Org minor-mode table editing in koutlines
;;
;; Author: Bob Weiner
;;
diff --git a/kotl/kprop-em.el b/kotl/kprop-em.el
deleted file mode 100644
index 3509331..0000000
--- a/kotl/kprop-em.el
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; kprop-em.el --- Koutline text property handling under GNU Emacs
-;;
-;; AUTHOR: Bob Weiner
-;;
-;; Orig-Date: 7/27/93
-;;
-;; Copyright (C) 1993-2016 Free Software Foundation, Inc.
-;; See the "../HY-COPY" file for license information.
-;;
-;; This file is part of GNU Hyperbole.
-
-;;; Commentary:
-
-;;; Code:
-;;; ************************************************************************
-;;; Other required Elisp libraries
-;;; ************************************************************************
-
-(require 'hversion)
-
-;;; ************************************************************************
-;;; Public functions
-;;; ************************************************************************
-
-(defalias 'kproperty:get 'get-text-property)
-
-(defun kproperty:map (function property value)
- "Apply FUNCTION to each character with PROPERTY `eq' to VALUE in the current
buffer.
-FUNCTION is called with the start and end points of the text span with the
matching PROPERTY
-and with point at the start."
- (let ((result)
- (start (point-min))
- end)
- (save-excursion
- (while (and (< start (point-max))
- (setq start (text-property-any start (point-max) property
value)))
- (goto-char start)
- (setq end (or (text-property-not-all start (point-max) property value)
(point-max))
- result (cons (funcall function start end) result)
- start end)))
- (nreverse result)))
-
-(defalias 'kproperty:next-single-change 'next-single-property-change)
-
-(defalias 'kproperty:previous-single-change 'previous-single-property-change)
-
-(defalias 'kproperty:properties 'text-properties-at)
-
-(defun kproperty:put (start end property-list &optional object)
- "From START to END, add PROPERTY-LIST properties to the text.
-The optional fourth argument, OBJECT, is the string or buffer containing the
-text. Text inserted before or after this region does not inherit the added
-properties."
- (add-text-properties
- start end (append property-list '(rear-nonsticky t)) object))
-
-(defun kproperty:remove (start end property-list &optional object)
- "From START to END, remove the text properties in PROPERTY-LIST.
-The optional fourth argument, OBJECT, is the string or buffer containing the
-text. PROPERTY-LIST should be a plist; if the value of a property is
-non-nil, then only a property with a matching value will be removed.
-Returns t if any property was changed, nil otherwise."
- (let ((changed) plist property value next)
- (while property-list
- (setq property (car property-list)
- value (car (cdr property-list))
- plist (list property value)
- property-list (nthcdr 2 property-list)
- next start)
- (while (setq next (text-property-any next end property value object))
- (remove-text-properties next (1+ next) plist object)
- (setq changed t next (1+ next))))
- changed))
-
-(defun kproperty:replace-separator (pos label-separator old-sep-len)
- "Replace at POS the cell label separator with LABEL-SEPARATOR.
-OLD-SEP-LEN is the length of the separator being replaced."
- (let (properties)
- (while (setq pos (kproperty:next-single-change (point) 'kcell))
- (goto-char pos)
- (setq properties (text-properties-at pos))
- ;; Replace label-separator while maintaining cell properties.
- (insert label-separator)
- (add-text-properties pos (+ pos 2) properties)
- (delete-region (point) (+ (point) old-sep-len)))))
-
-(defun kproperty:set (property value)
- "Set PROPERTY of character at point to VALUE."
- (kproperty:put (point) (min (+ 2 (point)) (point-max))
- (list property value)))
-
-;;; kprop-em.el ends here
diff --git a/kotl/kprop-xe.el b/kotl/kprop-xe.el
deleted file mode 100644
index d92b608..0000000
--- a/kotl/kprop-xe.el
+++ /dev/null
@@ -1,135 +0,0 @@
-;;; kprop-xe.el --- Koutline text property handling under XEmacs
-;;
-;; Author: Bob Weiner
-;;
-;; Orig-Date: 7/27/93
-;;
-;; Copyright (C) 1993-2016 Free Software Foundation, Inc.
-;; See the "../HY-COPY" file for license information.
-;;
-;; This file is part of GNU Hyperbole.
-
-;;; Commentary:
-
-;;; Code:
-;;; ************************************************************************
-;;; Other required Elisp libraries
-;;; ************************************************************************
-
-(require 'hversion)
-
-;;; ************************************************************************
-;;; Public functions
-;;; ************************************************************************
-
-;; (get-text-property (pos prop &optional object))
-;; Return the value of position POS's property PROP, in OBJECT.
-;; OBJECT is optional and defaults to the current buffer.
-;; If POSITION is at the end of OBJECT, the value is nil.
-(defalias 'kproperty:get 'get-text-property)
-
-(defun kproperty:map (function property &optional value)
- "Apply FUNCTION to each character with PROPERTY `eq' to VALUE in the current
buffer.
-FUNCTION is called with the start and end points of the text span with the
matching PROPERTY
-and with point at the start."
- (let ((result)
- (start) end)
- (save-excursion
- (map-extents (lambda (extent unused)
- (if (setq start (extent-start-position extent))
- (progn (goto-char start)
- (setq end (extent-end-position extent)
- result (cons (funcall function start
end) result))))
- nil)
- nil nil nil nil nil property value))
- (nreverse result)))
-
-;; (next-single-property-change (pos prop &optional object))
-;; Return the position of next property change for a specific property.
-;; Scans characters forward from POS till it finds
-;; a change in the PROP property, then returns the position of the change.
-;; The optional third argument OBJECT is the string or buffer to scan.
-;; Return nil if the property is constant all the way to the end of OBJECT.
-;; If the value is non-nil, it is a position greater than POS, never equal.
-(defalias 'kproperty:next-single-change 'next-single-property-change)
-
-;; (previous-single-property-change (pos prop &optional object))
-;; Return the position of previous property change for a specific property.
-;; Scans characters backward from POS till it finds
-;; a change in the PROP property, then returns the position of the change.
-;; The optional third argument OBJECT is the string or buffer to scan.
-;; Return nil if the property is constant all the way to the start of OBJECT.
-;; If the value is non-nil, it is a position less than POS, never equal.
-(defalias 'kproperty:previous-single-change 'previous-single-property-change)
-
-(defalias 'kproperty:properties 'extent-properties-at)
-
-(defun kproperty:put (start end property-list &optional object)
- "From START to END, add PROPERTY-LIST properties to the text.
-The optional fourth argument, OBJECT, is the string or buffer containing the
-text. Text inserted before or after this region does not inherit the added
-properties."
- ;; Don't use text properties internally because they don't work as desired
- ;; when copied to a string and then reinserted, at least in some versions
- ;; of XEmacs.
- (let ((extent (make-extent start end object)))
- (if (null extent)
- (error "(kproperty:put): No extent at %d-%d to add properties %s"
- start end property-list))
- (if (/= (mod (length property-list) 2) 0)
- (error "(kproperty:put): Property-list has odd number of elements, %s"
- property-list))
- (set-extent-property extent 'text-prop (car property-list))
- (set-extent-property extent 'duplicable t)
- (set-extent-property extent 'start-open t)
- (set-extent-property extent 'end-open t)
- (while property-list
- (set-extent-property
- extent (car property-list) (car (cdr property-list)))
- (setq property-list (nthcdr 2 property-list)))
- extent))
-
-(defun kproperty:remove (start end property-list &optional object)
- "From START to END, remove the text properties in PROPERTY-LIST.
-The optional fourth argument, OBJECT, is the string or buffer containing the
-text. PROPERTY-LIST should be a plist; if the value of a property is
-non-nil, then only a property with a matching value will be removed.
-Returns t if any property was changed, nil otherwise."
- ;; Don't use text property functions internally because they only look for
- ;; closed extents, which kproperty does not use.
- (let ((changed) property value)
- (while property-list
- (setq property (car property-list)
- value (car (cdr property-list))
- property-list (nthcdr 2 property-list))
- (map-extents
- (lambda (extent maparg)
- (if (extent-live-p extent)
- (progn (setq changed t)
- (delete-extent extent)))
- nil)
- object start end nil nil property value))
- changed))
-
-(defun kproperty:replace-separator (pos label-separator old-sep-len)
- "Replace at POS the cell label separator with LABEL-SEPARATOR.
-OLD-SEP-LEN is the length of the separator being replaced."
- (let (extent)
- (while (setq pos (kproperty:next-single-change (point) 'kcell))
- (goto-char pos)
- (setq extent (extent-at pos))
- ;; Replace label-separator while maintaining cell properties.
- (insert label-separator)
- (set-extent-endpoints extent pos (+ pos 2))
- (delete-region (point) (+ (point) old-sep-len)))))
-
-(defun kproperty:set (property value)
- "Set PROPERTY of character at point to VALUE."
- (kproperty:put (point) (min (+ 2 (point)) (point-max))
- (list property value)))
-
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
-
-;;; kprop-xe.el ends here
diff --git a/kotl/kproperty.el b/kotl/kproperty.el
index e1bec2d..865f9cc 100644
--- a/kotl/kproperty.el
+++ b/kotl/kproperty.el
@@ -1,25 +1,112 @@
-;;; kproperty.el --- Wrapper for koutline text property implementations
+;;; kproperty.el --- Kcell in-buffer property handling for the Koutliner
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 7/27/93
;;
-;; Copyright (C) 1993-2019 Free Software Foundation, Inc.
+;; Copyright (C) 1993-2021 Free Software Foundation, Inc.
;; See the "../HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;; Commentary:
+;; Stores and retrieves kcell properties as Emacs text properties
+;; at the kcell label separator.
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
-;; Ensures kotl/ is in load-path.
+;; Ensure kotl/ is in load-path.
(require 'hyperbole)
-(load "kprop-em")
+;;; ************************************************************************
+;;; Public functions
+;;; ************************************************************************
+
+(defun kproperty:add-properties (plist)
+ "Add properties at point and the following character from PLIST."
+ (kproperty:put (point) (min (+ 2 (point)) (point-max))
+ plist))
+
+(defun kproperty:all-positions (property value)
+ "Return a list of all non-narrowed buffer positions of kcells with PROPERTY
set to VALUE, else nil.
+Use (kcell-view:start <position>) on each returned <position> to get
+the start position of each cell's content."
+ (kproperty:map (lambda (start end) start) property value))
+
+(defalias 'kproperty:get 'get-text-property)
+
+(defun kproperty:map (function property value)
+ "Apply FUNCTION to each character with PROPERTY `eq' to VALUE in the current
buffer.
+FUNCTION is called with the start and end points of the text span with the
matching PROPERTY
+and with point at the start."
+ (let ((result)
+ (start (point-min))
+ end)
+ (save-excursion
+ (while (and (< start (point-max))
+ (setq start (text-property-any start (point-max) property
value)))
+ (goto-char start)
+ (setq end (or (text-property-not-all start (point-max) property value)
(point-max))
+ result (cons (funcall function start end) result)
+ start end)))
+ (nreverse result)))
+
+(defalias 'kproperty:next-single-change 'next-single-property-change)
+
+(defun kproperty:position (property value)
+ "Return the non-narrowed buffer position of the first kcell with PROPERTY
set to VALUE, else nil.
+Use (kcell-view:start <position>) on the returned <position> to get
+the start position of the cell's content."
+ (text-property-any (point-min) (point-max) property value))
+
+(defalias 'kproperty:previous-single-change 'previous-single-property-change)
+
+(defalias 'kproperty:properties 'text-properties-at)
+
+(defun kproperty:put (start end property-list &optional object)
+ "From START to END, add PROPERTY-LIST properties to the text.
+The optional fourth argument, OBJECT, is the string or buffer containing the
+text. Text inserted before or after this region does not inherit the added
+properties."
+ (add-text-properties
+ start end (append property-list '(rear-nonsticky t)) object))
+
+(defun kproperty:remove (start end property-list &optional object)
+ "From START to END, remove the text properties in PROPERTY-LIST.
+The optional fourth argument, OBJECT, is the string or buffer containing the
+text. PROPERTY-LIST should be a plist; if the value of a property is
+non-nil, then only a property with a matching value will be removed.
+Returns t if any property was changed, nil otherwise."
+ (let ((changed) plist property value next)
+ (while property-list
+ (setq property (car property-list)
+ value (car (cdr property-list))
+ plist (list property value)
+ property-list (nthcdr 2 property-list)
+ next start)
+ (while (setq next (text-property-any next end property value object))
+ (remove-text-properties next (1+ next) plist object)
+ (setq changed t next (1+ next))))
+ changed))
+
+(defun kproperty:replace-separator (pos label-separator old-sep-len)
+ "Replace at POS the cell label separator with LABEL-SEPARATOR.
+OLD-SEP-LEN is the length of the separator being replaced."
+ (let (properties)
+ (while (setq pos (kproperty:next-single-change (point) 'kcell))
+ (goto-char pos)
+ (setq properties (text-properties-at pos))
+ ;; Replace label-separator while maintaining cell properties.
+ (insert label-separator)
+ (add-text-properties pos (+ pos 2) properties)
+ (delete-region (point) (+ (point) old-sep-len)))))
+
+(defun kproperty:set (property value)
+ "Set PROPERTY of character at point and the following character to VALUE."
+ (kproperty:add-properties (list property value)))
(provide 'kproperty)
diff --git a/kotl/kview.el b/kotl/kview.el
index d815307..a3ff628 100644
--- a/kotl/kview.el
+++ b/kotl/kview.el
@@ -111,7 +111,19 @@ Return t unless no such cell."
(defun kcell-view:cell (&optional pos)
"Return kcell at optional POS or point."
- (kproperty:get (kcell-view:plist-point pos) 'kcell))
+ (kproperty:properties (kcell-view:plist-point pos)))
+
+(defun kcell-view:cell-from-ref (cell-ref)
+ "Return a kcell referenced by CELL-REF, a cell label, id string or integer
idstamp.
+Trigger an error if CELL-REF is not a string or is not found."
+ (if (or (stringp cell-ref)
+ (integerp cell-ref))
+ (let ((idstamp (kcell:ref-to-id cell-ref))
+ pos)
+ (or (and idstamp (setq pos (kproperty:position 'idstamp idstamp))
+ (kcell-view:cell pos))
+ (error "(kcell:get-from-ref): No such Koutline cell: '%s'"
cell-ref)))
+ (error "(kcell:get-from-ref): cell-ref arg must be a string, not: %s"
cell-ref)))
(defun kcell-view:child (&optional visible-p label-sep-len)
"Move to start of current cell's child.
@@ -200,8 +212,8 @@ Any cell that is invisible is also collapsed as indicated
by a call to
(concat "\\([\n\r]\\)" (make-string indent ?\ ))
(buffer-substring start end) "\\1"))))
-(defun kcell-view:create (kview cell level klabel &optional no-fill)
- "Insert into KVIEW at point, CELL at LEVEL (1 = first level) with KLABEL.
+(defun kcell-view:create (kview cell contents level klabel &optional no-fill)
+ "Insert into KVIEW at point, CELL with CONTENTS at LEVEL (1 = first level)
with KLABEL.
Optional NO-FILL non-nil suppresses filling of cell's contents upon insertion
or movement."
(unless (zerop (kcell:idstamp cell))
@@ -223,11 +235,11 @@ or movement."
(length label-separator)))
(old-point (point))
(fill-prefix (make-string thru-label ?\ ))
- contents new-point)
+ new-point)
(when no-fill
(kcell:set-attr cell 'no-fill t))
(insert fill-prefix)
- (setq contents (kview:insert-contents cell nil no-fill fill-prefix))
+ (setq contents (kview:insert-contents cell contents no-fill fill-prefix))
;; Insert lines to separate cell from next.
(insert (if (or no-fill (equal contents ""))
"\n\n" "\n"))
@@ -247,7 +259,7 @@ or movement."
(insert label-separator)
(goto-char old-point)
;; Add cell's attributes to the text property list at point.
- (kproperty:set 'kcell cell)
+ (kproperty:add-properties cell)
(goto-char new-point))))
(defun kcell-view:end (&optional pos)
@@ -471,10 +483,11 @@ or is nil), before it is returned."
(save-excursion
(when pos
(goto-char pos))
+
(let ((kcell (kcell:remove-attr (kcell-view:cell) attribute)))
(when (called-interactively-p 'interactive)
- (message "Cell <%s> now has no %s attribute."
- (kcell-view:label) attribute))1
+ (message "Cell <%s> now has no %s attribute."
+ (kcell-view:label) attribute))
kcell)))
(defun kcell-view:set-attr (attribute value &optional pos)
@@ -489,7 +502,7 @@ or is nil), before it is returned."
"Attach KCELL property to cell at point."
(save-excursion
(kcell-view:to-label-end)
- (kproperty:set 'kcell kcell)))
+ (kproperty:add-properties kcell)))
(defun kcell-view:sibling-p (&optional pos visible-p label-sep-len)
"Return t if cell at optional POS or point has a successor.
@@ -541,8 +554,8 @@ level."
(let* ((idstamp (if (klabel:idstamp-p klabel)
(if (stringp klabel) (string-to-number klabel) klabel)
(kview:id-increment kview)))
- (new-cell (kcell:create contents idstamp prop-list)))
- (kcell-view:create kview new-cell level klabel no-fill)
+ (new-cell (kcell:create idstamp prop-list)))
+ (kcell-view:create kview new-cell contents level klabel no-fill)
new-cell))
(defun kview:beginning-of-actual-line ()
@@ -704,25 +717,16 @@ the lines displayed, since it has hidden branches."
(t 0)))
kview t start end))
-(defun kview:goto-cell-id (id-string)
- "Move point to start of cell with idstamp ID-STRING and return t, else nil."
- (let ((cell-id (string-to-number id-string))
- (opoint (point))
- pos kcell)
- (goto-char (point-min))
- (while (and (setq pos (kproperty:next-single-change (point) 'kcell))
- (goto-char pos)
- (or (null (setq kcell (kproperty:get pos 'kcell)))
- (/= (kcell:idstamp kcell) cell-id))
- ;; Skip to the end of this kcell property
- (setq pos (kproperty:next-single-change (point) 'kcell))
- (goto-char pos)))
- (if pos
- (progn
- (forward-char (kview:label-separator-length kview))
- t)
- (goto-char opoint)
- nil)))
+(defun kview:goto-cell-id (idstamp-or-string)
+ "Move point to start of cell with permanent IDSTAMP-OR-STRING and return t,
else nil."
+ (let* ((idstamp (if (integerp idstamp-or-string)
+ idstamp-or-string
+ (string-to-number idstamp-or-string)))
+ (pos (kproperty:position 'idstamp idstamp)))
+ (when pos
+ (goto-char pos)
+ (forward-char (kview:label-separator-length kview))
+ t)))
(defun kview:id-counter (kview)
"Return the highest current idstamp (an integer) used by KVIEW."
@@ -742,12 +746,13 @@ the lines displayed, since it has hidden branches."
(defun kview:insert-contents (kcell contents no-fill fill-prefix)
"Insert KCELL's CONTENTS into view at point and fill resulting paragraphs,
unless NO-FILL is non-nil.
-FILL-PREFIX is the indentation string for the current cell.
-If CONTENTS is nil, get contents from KCELL. Return contents inserted (this
-value may differ from the value passed in.)"
+FILL-PREFIX is the indentation string for the current cell. If
+CONTENTS is nil, get contents from the cell at point. Return contents
+inserted (this value may differ from the value passed in) due to
+filling."
(let ((start (point))
end)
- (setq contents (or contents (kcell:contents kcell) ""))
+ (setq contents (or contents ""))
(insert contents)
;;
;; Delete any extra newlines at end of cell contents.
@@ -1057,9 +1062,10 @@ FILL-P is non-nil. Leave point at TO-START."
(if (< from-indent to-indent)
;; Add indent
(progn
- (setq expr (make-string (1+ (- to-indent from-indent)) ?\ ))
- (while (re-search-forward "^ " nil t)
- (replace-match expr t t)
+ (setq expr (concat (make-string (- to-indent from-indent) ?\ )
+ "\\&"))
+ (while (re-search-forward "^[^\n\r\f]" nil t)
+ (replace-match expr t)
(kfill:forward-line 1)))
;; Reduce indent in all but first cell lines.
(setq expr (concat "^" (make-string (- from-indent to-indent) ?\ )))
diff --git a/kotl/kvspec.el b/kotl/kvspec.el
index 257c6e7..51e723c 100644
--- a/kotl/kvspec.el
+++ b/kotl/kvspec.el
@@ -77,6 +77,7 @@ VIEW-SPEC is a string or t, which means recompute the current
view spec. See
<${hyperb:dir}/kotl/EXAMPLE.kotl, 2b17=048> for details on valid view specs."
(interactive (list (read-string "Set view spec: " kvspec:current)))
(kotl-mode:is-p)
+ (kfile:narrow-to-kcells)
(when (equal view-spec "")
(setq view-spec nil))
(kvspec:initialize)
