[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r103305: * lisp/allout-widgets.el: Ne
|
From: |
Ken Manheimer |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r103305: * lisp/allout-widgets.el: New allout extension that shows allout outline |
|
Date: |
Wed, 16 Feb 2011 17:10:43 -0500 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 103305
committer: Ken Manheimer <address@hidden>
branch nick: trunk
timestamp: Wed 2011-02-16 17:10:43 -0500
message:
* lisp/allout-widgets.el: New allout extension that shows allout outline
structure with graphical widgets. 'allout-widgets' customize group is an
'allout' subgroup, for easy discovery.
* etc/images/icons/allout-widgets-dark-bg,
etc/images/icons/allout-widgets-light-bg: Icons for new allout-widgets.el.
* etc/images/icons/README: Include coypright and GPL 3 license for new
icons.
added:
etc/images/icons/allout-widgets-dark-bg/
etc/images/icons/allout-widgets-dark-bg/closed.png
etc/images/icons/allout-widgets-dark-bg/closed.xpm
etc/images/icons/allout-widgets-dark-bg/empty.png
etc/images/icons/allout-widgets-dark-bg/empty.xpm
etc/images/icons/allout-widgets-dark-bg/encrypted-locked.png
etc/images/icons/allout-widgets-dark-bg/encrypted-locked.xpm
etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.png
etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.xpm
etc/images/icons/allout-widgets-dark-bg/end-connector.png
etc/images/icons/allout-widgets-dark-bg/end-connector.xpm
etc/images/icons/allout-widgets-dark-bg/extender-connector.png
etc/images/icons/allout-widgets-dark-bg/extender-connector.xpm
etc/images/icons/allout-widgets-dark-bg/leaf.png
etc/images/icons/allout-widgets-dark-bg/leaf.xpm
etc/images/icons/allout-widgets-dark-bg/mid-connector.png
etc/images/icons/allout-widgets-dark-bg/mid-connector.xpm
etc/images/icons/allout-widgets-dark-bg/opened.png
etc/images/icons/allout-widgets-dark-bg/opened.xpm
etc/images/icons/allout-widgets-dark-bg/skip-descender.png
etc/images/icons/allout-widgets-dark-bg/skip-descender.xpm
etc/images/icons/allout-widgets-dark-bg/through-descender.png
etc/images/icons/allout-widgets-dark-bg/through-descender.xpm
etc/images/icons/allout-widgets-light-bg/
etc/images/icons/allout-widgets-light-bg/closed.png
etc/images/icons/allout-widgets-light-bg/closed.xpm
etc/images/icons/allout-widgets-light-bg/empty.png
etc/images/icons/allout-widgets-light-bg/empty.xpm
etc/images/icons/allout-widgets-light-bg/encrypted-locked.png
etc/images/icons/allout-widgets-light-bg/encrypted-locked.xpm
etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.png
etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.xpm
etc/images/icons/allout-widgets-light-bg/end-connector.png
etc/images/icons/allout-widgets-light-bg/end-connector.xpm
etc/images/icons/allout-widgets-light-bg/extender-connector.png
etc/images/icons/allout-widgets-light-bg/extender-connector.xpm
etc/images/icons/allout-widgets-light-bg/leaf.png
etc/images/icons/allout-widgets-light-bg/leaf.xpm
etc/images/icons/allout-widgets-light-bg/mid-connector.png
etc/images/icons/allout-widgets-light-bg/mid-connector.xpm
etc/images/icons/allout-widgets-light-bg/opened.png
etc/images/icons/allout-widgets-light-bg/opened.xpm
etc/images/icons/allout-widgets-light-bg/skip-descender.png
etc/images/icons/allout-widgets-light-bg/skip-descender.xpm
etc/images/icons/allout-widgets-light-bg/through-descender.png
etc/images/icons/allout-widgets-light-bg/through-descender.xpm
lisp/allout-widgets.el
modified:
etc/ChangeLog
etc/images/icons/README
lisp/ChangeLog
=== modified file 'etc/ChangeLog'
--- a/etc/ChangeLog 2011-02-16 19:41:31 +0000
+++ b/etc/ChangeLog 2011-02-16 22:10:43 +0000
@@ -1,3 +1,12 @@
+2011-02-16 Ken Manheimer <address@hidden>
+
+ * etc/images/icons/allout-widgets-dark-bg,
+ etc/images/icons/allout-widgets-light-bg: Icons for new
+ allout-widgets.el.
+
+ * etc/images/icons/README: Include coypright and GPL 3 license for
+ new icons.
+
2011-02-16 Michael Albinus <address@hidden>
* NEWS: Add soap-client.el and soap-inspect.el.
=== modified file 'etc/images/icons/README'
--- a/etc/images/icons/README 2011-01-25 04:08:28 +0000
+++ b/etc/images/icons/README 2011-02-16 22:10:43 +0000
@@ -15,3 +15,52 @@
Author: Andrew Zhilin <address@hidden>
Copyright (C) 2005-2011 Free Software Foundation, Inc.
License: GNU General Public License version 3 or later (see COPYING)
+
+Files: allout-widgets-dark-bg/closed.png
+ allout-widgets-dark-bg/closed.xpm
+ allout-widgets-dark-bg/empty.png
+ allout-widgets-dark-bg/empty.xpm
+ allout-widgets-dark-bg/encrypted-locked.png
+ allout-widgets-dark-bg/encrypted-locked.xpm
+ allout-widgets-dark-bg/encrypted-unlocked.png
+ allout-widgets-dark-bg/encrypted-unlocked.xpm
+ allout-widgets-dark-bg/end-connector.png
+ allout-widgets-dark-bg/end-connector.xpm
+ allout-widgets-dark-bg/extender-connector.png
+ allout-widgets-dark-bg/extender-connector.xpm
+ allout-widgets-dark-bg/leaf.png
+ allout-widgets-dark-bg/leaf.xpm
+ allout-widgets-dark-bg/mid-connector.png
+ allout-widgets-dark-bg/mid-connector.xpm
+ allout-widgets-dark-bg/opened.png
+ allout-widgets-dark-bg/opened.xpm
+ allout-widgets-dark-bg/skip-descender.png
+ allout-widgets-dark-bg/skip-descender.xpm
+ allout-widgets-dark-bg/through-descender.png
+ allout-widgets-dark-bg/through-descender.xpm
+ allout-widgets-light-bg/closed.png
+ allout-widgets-light-bg/closed.xpm
+ allout-widgets-light-bg/empty.png
+ allout-widgets-light-bg/empty.xpm
+ allout-widgets-light-bg/encrypted-locked.png
+ allout-widgets-light-bg/encrypted-locked.xpm
+ allout-widgets-light-bg/encrypted-unlocked.png
+ allout-widgets-light-bg/encrypted-unlocked.xpm
+ allout-widgets-light-bg/end-connector.png
+ allout-widgets-light-bg/end-connector.xpm
+ allout-widgets-light-bg/extender-connector.png
+ allout-widgets-light-bg/extender-connector.xpm
+ allout-widgets-light-bg/leaf.png
+ allout-widgets-light-bg/leaf.xpm
+ allout-widgets-light-bg/mid-connector.png
+ allout-widgets-light-bg/mid-connector.xpm
+ allout-widgets-light-bg/opened.png
+ allout-widgets-light-bg/opened.xpm
+ allout-widgets-light-bg/skip-descender.png
+ allout-widgets-light-bg/skip-descender.xpm
+ allout-widgets-light-bg/through-descender.png
+ allout-widgets-light-bg/through-descender.xpm
+
+Author: Ken Manheimer <address@hidden>
+Copyright (C) 2011 Free Software Foundation, Inc.
+License: GNU General Public License version 3 or later (see COPYING)
=== added directory 'etc/images/icons/allout-widgets-dark-bg'
=== added file 'etc/images/icons/allout-widgets-dark-bg/closed.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/closed.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/closed.png 2011-02-16 22:10:43
+0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/closed.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/closed.xpm 1970-01-01
00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-dark-bg/closed.xpm 2011-02-16
22:10:43 +0000
@@ -0,0 +1,30 @@
+/* XPM */
+static char *dummy[]={
+"9 17 10 1",
+". c None",
+"# c #000080",
+"h c #52a55a",
+"g c #52ad52",
+"e c #5ab54a",
+"d c #5abd42",
+"c c #63c639",
+"b c #63ce31",
+"f c #ada5c6",
+"a c #ffff00",
+".........",
+".........",
+".........",
+"######...",
+"aaaaaa#..",
+".bbcdaa#.",
+".###deaa#",
+"..ff##gaa",
+"fffff##ha",
+"..ff##haa",
+".###ghaa#",
+".eeggaa#.",
+"aaaaaa#..",
+"######...",
+".........",
+".........",
+"........."};
=== added file 'etc/images/icons/allout-widgets-dark-bg/empty.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/empty.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/empty.png 2011-02-16 22:10:43
+0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/empty.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/empty.xpm 1970-01-01 00:00:00
+0000
+++ b/etc/images/icons/allout-widgets-dark-bg/empty.xpm 2011-02-16 22:10:43
+0000
@@ -0,0 +1,29 @@
+/* XPM */
+static char *dummy[]={
+"10 17 9 1",
+". c None",
+"# c #000080",
+"f c #52a55a",
+"g c #52ad52",
+"d c #5abd42",
+"b c #63c639",
+"c c #6bd629",
+"e c #ada5c6",
+"a c #ffff00",
+"..........",
+"..........",
+"..........",
+"...######.",
+"..#aaaaaa.",
+".#aabbbb..",
+"#aabc###..",
+"aad##ee...",
+"adeeeee...",
+"aad##ee...",
+"#aafg###..",
+".#aabbbb..",
+"..#aaaaaa.",
+"...######.",
+"..........",
+"..........",
+".........."};
=== added file 'etc/images/icons/allout-widgets-dark-bg/encrypted-locked.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/encrypted-locked.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/encrypted-locked.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/encrypted-locked.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/encrypted-locked.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-dark-bg/encrypted-locked.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,26 @@
+/* XPM */
+static char *dummy[]={
+"10 17 6 1",
+". c None",
+"b c #333300",
+"# c #666600",
+"d c #808080",
+"c c #999933",
+"a c #999966",
+"..........",
+"..........",
+"..........",
+"..........",
+"...##a#...",
+"..aaaaaa..",
+".aa....##.",
+".ab....a#.",
+".cb....#b.",
+"caaaaaaacb",
+"cddddddddb",
+"adaddddddb",
+"adaddddddb",
+"caadddddab",
+"addddddddb",
+"bbbbbbbbbb",
+".........."};
=== added file 'etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-dark-bg/encrypted-unlocked.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,26 @@
+/* XPM */
+static char *dummy[]={
+"10 17 6 1",
+". c None",
+"c c #333300",
+"a c #666600",
+"b c #999933",
+"# c #999966",
+"d c #ffff00",
+"..........",
+"..........",
+"..........",
+"...####...",
+"..#a#a###.",
+"..a#...##.",
+".a#.....#.",
+".##.......",
+"..##......",
+"b###c###bc",
+"bddddddddc",
+"#d#ddddddc",
+"#d#ddddddc",
+"b##ddddd#c",
+"#ddddddddc",
+"cccccccccc",
+".........."};
=== added file 'etc/images/icons/allout-widgets-dark-bg/end-connector.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/end-connector.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/end-connector.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/end-connector.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/end-connector.xpm 1970-01-01
00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-dark-bg/end-connector.xpm 2011-02-16
22:10:43 +0000
@@ -0,0 +1,22 @@
+/* XPM */
+static char *dummy[]={
+"11 17 2 1",
+". c None",
+"# c #ada5c6",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....##.....",
+".....######",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"..........."};
=== added file 'etc/images/icons/allout-widgets-dark-bg/extender-connector.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/extender-connector.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/extender-connector.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/extender-connector.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/extender-connector.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-dark-bg/extender-connector.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,22 @@
+/* XPM */
+static char *dummy[]={
+"11 17 2 1",
+". c None",
+"# c #ada5c6",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"###########",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"..........."};
=== added file 'etc/images/icons/allout-widgets-dark-bg/leaf.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/leaf.png 1970-01-01
00:00:00 +0000 and b/etc/images/icons/allout-widgets-dark-bg/leaf.png
2011-02-16 22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/leaf.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/leaf.xpm 1970-01-01 00:00:00
+0000
+++ b/etc/images/icons/allout-widgets-dark-bg/leaf.xpm 2011-02-16 22:10:43
+0000
@@ -0,0 +1,33 @@
+/* XPM */
+static char *dummy[]={
+"16 21 9 1",
+". c None",
+"a c #737373",
+"b c #7b7b7b",
+"# c #808080",
+"c c #848484",
+"d c #8c8c8c",
+"e c #949494",
+"f c #9c9c9c",
+"g c #a5a5a5",
+"................",
+"................",
+"................",
+"................",
+"................",
+"................",
+"...#####........",
+"..#abbcc#.......",
+".#abbccdd#......",
+"#abbccddee#.....",
+"#bbccddeef#.....",
+"#bccddeefg#.....",
+".#cddeefg#......",
+"..#deefg#.......",
+"...#####........",
+"................",
+"................",
+"................",
+"................",
+"................",
+"................"};
=== added file 'etc/images/icons/allout-widgets-dark-bg/mid-connector.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/mid-connector.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/mid-connector.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/mid-connector.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/mid-connector.xpm 1970-01-01
00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-dark-bg/mid-connector.xpm 2011-02-16
22:10:43 +0000
@@ -0,0 +1,22 @@
+/* XPM */
+static char *dummy[]={
+"11 17 2 1",
+". c None",
+"# c #ada5c6",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....##.....",
+"....#.#####",
+"....##.....",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......"};
=== added file 'etc/images/icons/allout-widgets-dark-bg/opened.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/opened.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/opened.png 2011-02-16 22:10:43
+0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/opened.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/opened.xpm 1970-01-01
00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-dark-bg/opened.xpm 2011-02-16
22:10:43 +0000
@@ -0,0 +1,25 @@
+/* XPM */
+static char *dummy[]={
+"10 17 5 1",
+". c None",
+"a c #000080",
+"b c #63c639",
+"c c #ada5c6",
+"# c #ffff00",
+"..........",
+"..........",
+"..........",
+"..........",
+"#.......#a",
+"#ba...ab#a",
+"#ba...ab#a",
+"#bccccab#a",
+"#bacccab#a",
+"#bbacabb#a",
+"##bacab##a",
+"a##bbb##a.",
+".a#####a..",
+"..a###a...",
+"...a#a....",
+"....c.....",
+"....c....."};
=== added file 'etc/images/icons/allout-widgets-dark-bg/skip-descender.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/skip-descender.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/skip-descender.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/skip-descender.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/skip-descender.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-dark-bg/skip-descender.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,21 @@
+/* XPM */
+static char *dummy[]={
+"11 17 1 1",
+". c None",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"..........."};
=== added file 'etc/images/icons/allout-widgets-dark-bg/through-descender.png'
Binary files a/etc/images/icons/allout-widgets-dark-bg/through-descender.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-dark-bg/through-descender.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-dark-bg/through-descender.xpm'
--- a/etc/images/icons/allout-widgets-dark-bg/through-descender.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-dark-bg/through-descender.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,22 @@
+/* XPM */
+static char *dummy[]={
+"11 17 2 1",
+". c None",
+"# c #ada5c6",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......"};
=== added directory 'etc/images/icons/allout-widgets-light-bg'
=== added file 'etc/images/icons/allout-widgets-light-bg/closed.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/closed.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/closed.png 2011-02-16 22:10:43
+0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/closed.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/closed.xpm 1970-01-01
00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/closed.xpm 2011-02-16
22:10:43 +0000
@@ -0,0 +1,24 @@
+/* XPM */
+static char *dummy[]={
+"9 17 4 1",
+". c None",
+"# c #00ff00",
+"b c #00ffff",
+"a c #606060",
+".........",
+".........",
+".........",
+"######...",
+"aaaaaa#..",
+".bbbbaa#.",
+"....bbaa#",
+"..aa..baa",
+"aaaaa..ba",
+"..aa..baa",
+"....bbaa#",
+".bbbbaa#.",
+"aaaaaa#..",
+"######...",
+".........",
+".........",
+"........."};
=== added file 'etc/images/icons/allout-widgets-light-bg/empty.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/empty.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/empty.png 2011-02-16 22:10:43
+0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/empty.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/empty.xpm 1970-01-01
00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/empty.xpm 2011-02-16
22:10:43 +0000
@@ -0,0 +1,24 @@
+/* XPM */
+static char *dummy[]={
+"10 17 4 1",
+". c None",
+"# c #00ff00",
+"b c #00ffff",
+"a c #606060",
+"..........",
+"..........",
+"..........",
+"...######.",
+"..#aaaaaa.",
+".#aabbbb..",
+"#aabb.....",
+"aab..aa...",
+"abaaaaa...",
+"aab..aa...",
+"#aabb.....",
+".#aabbbb..",
+"..#aaaaaa.",
+"...######.",
+"..........",
+"..........",
+".........."};
=== added file 'etc/images/icons/allout-widgets-light-bg/encrypted-locked.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/encrypted-locked.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/encrypted-locked.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/encrypted-locked.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/encrypted-locked.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/encrypted-locked.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,26 @@
+/* XPM */
+static char *dummy[]={
+"10 17 6 1",
+". c None",
+"b c #333300",
+"# c #666600",
+"d c #808080",
+"c c #999933",
+"a c #999966",
+"..........",
+"..........",
+"..........",
+"..........",
+"...##a#...",
+"..aaaaaa..",
+".aa....##.",
+".ab....a#.",
+".cb....#b.",
+"caaaaaaacb",
+"cddddddddb",
+"adaddddddb",
+"adaddddddb",
+"caadddddab",
+"addddddddb",
+"bbbbbbbbbb",
+".........."};
=== added file 'etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/encrypted-unlocked.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,26 @@
+/* XPM */
+static char *dummy[]={
+"10 17 6 1",
+". c None",
+"c c #333300",
+"a c #666600",
+"b c #999933",
+"# c #999966",
+"d c #ffff00",
+"..........",
+"..........",
+"..........",
+"...####...",
+"..#a#a###.",
+"..a#...##.",
+".a#.....#.",
+".##.......",
+"..##......",
+"b###c###bc",
+"bddddddddc",
+"#d#ddddddc",
+"#d#ddddddc",
+"b##ddddd#c",
+"#ddddddddc",
+"cccccccccc",
+".........."};
=== added file 'etc/images/icons/allout-widgets-light-bg/end-connector.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/end-connector.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/end-connector.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/end-connector.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/end-connector.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/end-connector.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,22 @@
+/* XPM */
+static char *dummy[]={
+"11 17 2 1",
+". c None",
+"# c #606060",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....##.....",
+".....######",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"..........."};
=== added file 'etc/images/icons/allout-widgets-light-bg/extender-connector.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/extender-connector.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/extender-connector.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/extender-connector.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/extender-connector.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/extender-connector.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,22 @@
+/* XPM */
+static char *dummy[]={
+"11 17 2 1",
+". c None",
+"# c #606060",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"###########",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"..........."};
=== added file 'etc/images/icons/allout-widgets-light-bg/leaf.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/leaf.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/leaf.png 2011-02-16 22:10:43
+0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/leaf.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/leaf.xpm 1970-01-01 00:00:00
+0000
+++ b/etc/images/icons/allout-widgets-light-bg/leaf.xpm 2011-02-16 22:10:43
+0000
@@ -0,0 +1,33 @@
+/* XPM */
+static char *dummy[]={
+"16 21 9 1",
+". c None",
+"a c #737373",
+"b c #7b7b7b",
+"# c #808080",
+"c c #848484",
+"d c #8c8c8c",
+"e c #949494",
+"f c #9c9c9c",
+"g c #a5a5a5",
+"................",
+"................",
+"................",
+"................",
+"................",
+"................",
+"...#####........",
+"..#abbcc#.......",
+".#abbccdd#......",
+"#abbccddee#.....",
+"#bbccddeef#.....",
+"#bccddeefg#.....",
+".#cddeefg#......",
+"..#deefg#.......",
+"...#####........",
+"................",
+"................",
+"................",
+"................",
+"................",
+"................"};
=== added file 'etc/images/icons/allout-widgets-light-bg/mid-connector.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/mid-connector.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/mid-connector.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/mid-connector.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/mid-connector.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/mid-connector.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,22 @@
+/* XPM */
+static char *dummy[]={
+"11 17 2 1",
+". c None",
+"# c #606060",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....##.....",
+"....#.#####",
+"....##.....",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......"};
=== added file 'etc/images/icons/allout-widgets-light-bg/opened.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/opened.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/opened.png 2011-02-16 22:10:43
+0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/opened.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/opened.xpm 1970-01-01
00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/opened.xpm 2011-02-16
22:10:43 +0000
@@ -0,0 +1,24 @@
+/* XPM */
+static char *dummy[]={
+"10 17 4 1",
+". c None",
+"a c #00ff00",
+"b c #00ffff",
+"# c #606060",
+"..........",
+"..........",
+"..........",
+"..........",
+"#.......#a",
+"#b.....b#a",
+"#b.....b#a",
+"#b####.b#a",
+"#b.###.b#a",
+"#bb.#.bb#a",
+"##b.#.b##a",
+"a##b#b##a.",
+".a##b##a..",
+"..a###a...",
+"...a#a....",
+"....#.....",
+"....#....."};
=== added file 'etc/images/icons/allout-widgets-light-bg/skip-descender.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/skip-descender.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/skip-descender.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/skip-descender.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/skip-descender.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/skip-descender.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,21 @@
+/* XPM */
+static char *dummy[]={
+"11 17 1 1",
+". c None",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"...........",
+"..........."};
=== added file 'etc/images/icons/allout-widgets-light-bg/through-descender.png'
Binary files a/etc/images/icons/allout-widgets-light-bg/through-descender.png
1970-01-01 00:00:00 +0000 and
b/etc/images/icons/allout-widgets-light-bg/through-descender.png 2011-02-16
22:10:43 +0000 differ
=== added file 'etc/images/icons/allout-widgets-light-bg/through-descender.xpm'
--- a/etc/images/icons/allout-widgets-light-bg/through-descender.xpm
1970-01-01 00:00:00 +0000
+++ b/etc/images/icons/allout-widgets-light-bg/through-descender.xpm
2011-02-16 22:10:43 +0000
@@ -0,0 +1,22 @@
+/* XPM */
+static char *dummy[]={
+"11 17 2 1",
+". c None",
+"# c #606060",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......",
+"....#......"};
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-02-16 21:29:32 +0000
+++ b/lisp/ChangeLog 2011-02-16 22:10:43 +0000
@@ -1,5 +1,9 @@
2011-02-16 Ken Manheimer <address@hidden>
+ * allout-widgets.el: New allout extension that shows allout
+ outline structure with graphical widgets. 'allout-widgets'
+ customize group is an 'allout' subgroup, for easy discovery.
+
* allout.el: Include PGP and GnuPG in Keywords, and other
commentary refinements.
(allout-abbreviate-flattened-numbering): Rename to
=== added file 'lisp/allout-widgets.el'
--- a/lisp/allout-widgets.el 1970-01-01 00:00:00 +0000
+++ b/lisp/allout-widgets.el 2011-02-16 22:10:43 +0000
@@ -0,0 +1,2365 @@
+;; allout-widgets.el --- Show allout outline structure with graphical widgets.
+
+;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 Ken Manheimer
+
+;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
+;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
+;; Version: 1.0
+;; Created: Dec 2005
+;; Version: 1.0
+;; Keywords: outlines
+;; Website: http://myriadicity.net/Sundry/EmacsAllout
+
+;;; Commentary:
+
+;; This is an allout outline-mode add-on that highlights outline structure
+;; with graphical widgets.
+;;
+;; To activate, customize `allout-widgets-auto-activation'. You can also
+;; invoke allout-widgets-mode in a particular allout buffer. When
+;; auto-enabled, you can inhibit widget operation in particular allout
+;; buffers by setting the variable `allout-widgets-mode-inhibit' non-nil in
+;; that file's buffer. Use emacs *file local variables* to generally
+;; inhibit for a file.
+;;
+;; See the `allout-widgets-mode' docstring for more details.
+;;
+;; Info about allout and allout-widgets development are available at
+;; http://myriadicity.net/Sundry/EmacsAllout
+;;
+;; The graphics include:
+;;
+;; - icons for item bullets, varying to distinguish whether the item either
+;; lacks any subitems, the subitems are currently collapsed within the
+;; item, or the item is currently expanded.
+;;
+;; - guide lines connecting item bullet-icons with those of their subitems.
+;;
+;; - cue area between the bullet-icon and the start of the body headline,
+;; for item numbering, encryption indicator, and distinctive bullets.
+;;
+;; The bullet-icon and guide line graphics provide keybindings and mouse
+;; bindings for easy outline navigation and exposure control, extending
+;; outline hot-spot navigation (see `allout-mode' docstring for details).
+;;
+;; Developers note: Our use of emacs widgets is unconventional. We
+;; decorate existing text rather than substituting for it, to
+;; piggy-back on existing allout operation. This employs the C-coded
+;; efficiencies of widget-apply, widget-get, and widget-put, along
+;; with the basic object-oriented organization of widget-create, to
+;; systematically couple overlays, graphics, and other features with
+;; allout-governed text.
+
+;;;_: Code (structured with comments that delinieate an allout outline)
+
+;;;_ : General Environment
+(require 'allout)
+(require 'widget)
+(require 'wid-edit)
+
+(eval-when-compile
+ (progn
+ (require 'overlay)
+ (require 'cl)
+ ))
+
+;;;_ : internal variables needed before user-customization variables
+;;; In order to enable activation of allout-widgets-mode via customization,
+;;; allout-widgets-auto-activation uses a setting function. That function
+;;; is invoked when the customization variable definition is evaluated,
+;;; during file load, so the involved code must reside above that
+;;; definition in the file.
+;;;_ = allout-widgets-mode
+(defvar allout-widgets-mode nil
+ "Allout mode enhanced with graphical widgets.")
+(make-variable-buffer-local 'allout-widgets-mode)
+
+;;;_ : USER CUSTOMIZATION VARIABLES and incidental functions:
+;;;_ > defgroup allout-widgets
+;;;###autoload
+(defgroup allout-widgets nil
+ "Allout extension that highlights outline structure graphically.
+
+Customize `allout-widgets-auto-activation' to activate allout-widgets
+with allout-mode."
+ :group 'allout)
+;;;_ > defgroup allout-widgets-developer
+(defgroup allout-widgets-developer nil
+ "Settings for development of allout widgets extension."
+ :group 'allout-widgets)
+;;;_ ; some functions a bit early, for allout-auto-activation dependency:
+;;;_ > allout-widgets-mode-enable
+(defun allout-widgets-mode-enable ()
+ "Enable allout-widgets-mode in allout-mode buffers.
+
+See `allout-widgets-mode-inhibit' for per-file/per-buffer
+inhibition of allout-widgets-mode."
+ (add-hook 'allout-mode-off-hook 'allout-widgets-mode-off)
+ (add-hook 'allout-mode-on-hook 'allout-widgets-mode-on)
+ t)
+;;;_ > allout-widgets-mode-disable
+(defun allout-widgets-mode-disable ()
+ "Disable allout-widgets-mode in allout-mode buffers.
+
+See `allout-widgets-mode-inhibit' for per-file/per-buffer
+inhibition of allout-widgets-mode."
+ (remove-hook 'allout-mode-off-hook 'allout-widgets-mode-off)
+ (remove-hook 'allout-mode-on-hook 'allout-widgets-mode-on)
+ t)
+;;;_ > allout-widgets-setup (varname value)
+;;;###autoload
+(defun allout-widgets-setup (varname value)
+ "Commission or decommision allout-widgets-mode along with allout-mode.
+
+Meant to be used by customization of `allout-widgets-auto-activation'."
+ (set-default varname value)
+ (if allout-widgets-auto-activation
+ (allout-widgets-mode-enable)
+ (allout-widgets-mode-disable)))
+;;;_ = allout-widgets-auto-activation
+;;;###autoload
+(defcustom allout-widgets-auto-activation nil
+ "Activate to enable allout icon graphics wherever allout mode is active.
+
+Also enable `allout-auto-activation' for this to take effect upon
+visiting an outline.
+
+When this is set you can disable allout widgets in select files
+by setting `allout-widgets-mode-inhibit'
+
+Instead of setting `allout-widgets-auto-activation' you can
+explicitly invoke `allout-widgets-mode' in allout buffers where
+you want allout widgets operation.
+
+See `allout-widgets-mode' for allout widgets mode features."
+ :type 'boolean
+ :group 'allout-widgets
+ :set 'allout-widgets-setup
+ )
+;; ;;;_ = allout-widgets-allow-unruly-edits
+;; (defcustom allout-widgets-allow-unruly-edits nil
+;; "*Control whether manual edits are restricted to maintain outline
integrity.
+
+;; When nil, manual edits must either be within an item's body or encompass
+;; one or more items completely - eg, killing topics as entities, rather than
+;; deleting from the middle of one to the middle of another.
+
+;; If you only occasionally need to make unrestricted change, you can set this
+;; variable in the specific buffer using set-variable, or just deactivate
+;; `allout-mode' temporarily. You can customize this to always allow unruly
+;; edits, but you will be able to create outlines that are unnavigable in
+;; principle, and not just for allout's navigation and exposure mechanisms."
+;; :type 'boolean
+;; :group allout-widgets)
+;; (make-variable-buffer-local 'allout-widgets-allow-unruly-edits)
+;;;_ = allout-widgets-auto-activation - below, for eval-order dependencies
+;;;_ = allout-widgets-icons-dark-subdir
+(defcustom allout-widgets-icons-dark-subdir "icons/allout-widgets-dark-bg/"
+ "Directory on `image-load-path' holding allout icons for dark backgrounds."
+ :type 'string
+ :group 'allout-widgets)
+;;;_ = allout-widgets-icons-light-subdir
+(defcustom allout-widgets-icons-light-subdir "icons/allout-widgets-light-bg/"
+ "Directory on `image-load-path' holding allout icons for light backgrounds."
+ :type 'string
+ :group 'allout-widgets)
+;;;_ = allout-widgets-icon-types
+(defcustom allout-widgets-icon-types '(xpm png)
+ "File extensions for the icon graphic format types, in order of preference."
+ :type '(repeat symbol)
+ :group 'allout-widgets)
+
+;;;_ . Decoration format
+;;;_ = allout-widgets-theme-dark-background
+(defcustom allout-widgets-theme-dark-background "allout-dark-bg"
+ "Identify the outline's icon theme to use with a dark background."
+ :type '(string)
+ :group 'allout-widgets)
+;;;_ = allout-widgets-theme-light-background
+(defcustom allout-widgets-theme-light-background "allout-light-bg"
+ "Identify the outline's icon theme to use with a light background."
+ :type '(string)
+ :group 'allout-widgets)
+;;;_ = allout-widgets-item-image-properties-emacs
+(defcustom allout-widgets-item-image-properties-emacs
+ '(:ascent center :mask (heuristic t))
+ "*Default properties item widget images in mainline Emacs."
+ :type 'plist
+ :group 'allout-widgets)
+;;;_ = allout-widgets-item-image-properties-xemacs
+(defcustom allout-widgets-item-image-properties-xemacs
+ nil
+ "*Default properties item widget images in XEmacs."
+ :type 'plist
+ :group 'allout-widgets)
+;;;_ . Developer
+;;;_ = allout-widgets-run-unit-tests-on-load
+(defcustom allout-widgets-run-unit-tests-on-load nil
+ "*When non-nil, unit tests will be run at end of loading allout-widgets.
+
+Generally, allout widgets code developers are the only ones who'll want to
+set this.
+
+\(If set, this makes it an even better practice to exercise changes by
+doing byte-compilation with a repeat count, so the file is loaded after
+compilation.)
+
+See `allout-widgets-run-unit-tests' to see what's run."
+ :type 'boolean
+ :group 'allout-widgets-developer)
+;;;_ = allout-widgets-time-decoration-activity
+(defcustom allout-widgets-time-decoration-activity nil
+ "*Retain timing info of the last cooperative redecoration.
+
+The details are retained as the value of
+`allout-widgets-last-decoration-timing'.
+
+Generally, allout widgets code developers are the only ones who'll want to
+set this."
+ :type 'boolean
+ :group 'allout-widgets-developer)
+;;;_ = allout-widgets-hook-error-post-time 0
+(defcustom allout-widgets-hook-error-post-time 0
+ "*Amount of time to sit showing hook error messages.
+
+0 is minimal, or nil to not post to the message area.
+
+This is for debugging purposes."
+ :type 'integer
+ :group 'allout-widgets-developer)
+;;;_ = allout-widgets-maintain-tally nil
+(defcustom allout-widgets-maintain-tally nil
+ "*If non-nil, maintain a collection of widgets, `allout-widgets-tally'.
+
+This is for debugging purposes.
+
+The tally shows the total number of item widgets in the current
+buffer, and tracking increases as new widgets are added and
+decreases as obsolete widgets are garbage collected."
+ :type 'boolean
+ :group 'allout-widgets-developer)
+(defvar allout-widgets-tally nil
+ "Hash-table of existing allout widgets, for debugging.
+
+Table is maintained iff `allout-widgets-maintain-tally' is non-nil.
+
+The table contents will be out of sync if any widgets are created
+or deleted while this variable is nil.")
+(make-variable-buffer-local 'allout-widgets-tally)
+;;;_ > allout-widgets-tally-string
+(defun allout-widgets-tally-string ()
+ "Return a string giving the number of tracked widgets, or empty string if
not tracking.
+
+The string is formed for appending to the allout-mode mode-line lighter.
+
+An empty string is also returned if tracking is inhibited or
+widgets are locally inhibited.
+
+The number varies according to the evanescence of objects on a
+ hash table with weak keys, so tracking of widget erasures is often delayed."
+ (when (and allout-widgets-maintain-tally (not allout-widgets-mode-inhibit))
+ (format ":%s" (hash-table-count allout-widgets-tally))))
+;;;_ = allout-widgets-track-decoration nil
+(defcustom allout-widgets-track-decoration nil
+ "*If non-nil, show cursor position of each item decoration.
+
+This is for debugging purposes, and generally set at need in a
+buffer rather than as a prevailing configuration \(but it's handy
+to publicize it by making it a customization variable\)."
+ :type 'boolean
+ :group 'allout-widgets-developer)
+(make-variable-buffer-local 'allout-widgets-track-decoration)
+
+;;;_ : Mode context - variables, hookup, and hooks
+;;;_ . internal mode variables
+;;;_ , Mode activation and environment
+;;;_ = allout-widgets-version
+(defvar allout-widgets-version "1.0"
+ "Version of currently loaded allout-widgets extension.")
+;;;_ > allout-widgets-version
+(defun allout-widgets-version (&optional here)
+ "Return string describing the loaded outline version."
+ (interactive "P")
+ (let ((msg (concat "Allout Outline Widgets Extension v "
+ allout-widgets-version)))
+ (if here (insert msg))
+ (message "%s" msg)
+ msg))
+;;;_ = allout-widgets-mode-inhibit
+(defvar allout-widgets-mode-inhibit nil
+ "Inhibit `allout-widgets-mode' from activating widgets.
+
+This also inhibits automatic adjustment of widgets to track allout outline
+changes.
+
+You can use this as a file local variable setting to disable
+allout widgets enhancements in selected buffers while generally
+enabling widgets by customizing `allout-widgets-auto-activation'.
+
+In addition, you can invoked `allout-widgets-mode' allout-mode
+buffers where this is set to enable and disable widget
+enhancements, directly.")
+;;;###autoload
+(put 'allout-widgets-mode-inhibit 'safe-local-variable
+ (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+(make-variable-buffer-local 'allout-widgets-mode-inhibit)
+;;;_ = allout-inhibit-body-modification-hook
+(defvar allout-inhibit-body-modification-hook nil
+ "Override de-escaping of text-prefixes in item bodies during specific
changes.
+
+This is used by `allout-buffer-modification-handler' to signal such changes
+to `allout-body-modification-handler', and is always reset by
+`allout-post-command-business'.")
+(make-variable-buffer-local 'allout-inhibit-body-modification-hook)
+;;;_ = allout-widgets-icons-cache
+(defvar allout-widgets-icons-cache nil
+ "Cache allout icon images, as an association list.
+
+`allout-fetch-icon-image' uses this cache transparently, keying
+images with lists containing the name of the icon directory \(as
+found on the `load-path') and the icon name.
+
+Set this variable to `nil' to empty the cache, and have it replenish from the
+filesystem.")
+;;;_ = allout-widgets-unset-inhibit-read-only
+(defvar allout-widgets-unset-inhibit-read-only nil
+ "Tell `allout-widgets-post-command-business' to unset `inhibit-read-only'.
+
+Used by `allout-graphics-modification-handler'")
+;;;_ = allout-widgets-reenable-before-change-handler
+(defvar allout-widgets-reenable-before-change-handler nil
+ "Tell `allout-widgets-post-command-business' to reequip the handler.
+
+Necessary because the handler sometimes deliberately raises an
+error, causing it to be disabled.")
+;;;_ , State for hooks
+;;;_ = allout-unresolved-body-mod-workroster
+(defvar allout-unresolved-body-mod-workroster (make-hash-table :size 16)
+ "List of body-overlays that did before-change business but not after-change.
+
+See `allout-post-command-business' and `allout-body-modification-handler'.")
+;;;_ = allout-structure-unruly-deletion-message
+(defvar allout-structure-unruly-deletion-message
+ "Unruly edit prevented --
+To change the bullet character: \\[allout-rebullet-current-heading]
+To promote this item: \\[allout-shift-out]
+To demote it: \\[allout-shift-in]
+To delete it and offspring: \\[allout-kill-topic]
+See \\[describe-mode] for many more options."
+ "Informative message presented on improper editing of outline structure.
+
+The structure includes the guides lines, bullet, and bullet cue.")
+;;;_ = allout-widgets-changes-record
+(defvar allout-widgets-changes-record nil
+ "Record outline changes for processing by post-command hook.
+
+Entries on the list are lists whose first element is a symbol indicating
+the change type and subsequent elements are data specific to that change
+type. Specifically:
+
+ 'exposure `allout-exposure-from' `allout-exposure-to' `allout-exposure-flag'
+
+The changes are recorded in reverse order, with new values pushed
+onto the front.")
+(make-variable-buffer-local 'allout-widgets-changes-record)
+;;;_ = allout-widgets-undo-exposure-record
+(defvar allout-widgets-undo-exposure-record nil
+ "Record outline undo traces for processing by post-command hook.
+
+The changes are recorded in reverse order, with new values pushed
+onto the front.")
+(make-variable-buffer-local 'allout-widgets-undo-exposure-record)
+;;;_ = allout-widgets-last-hook-error
+(defvar allout-widgets-last-hook-error nil
+ "String holding last error string, for debugging purposes.")
+;;;_ = allout-widgets-adjust-message-length-threshold 100
+(defvar allout-widgets-adjust-message-length-threshold 100
+ "Display \"Adjusting widgets\" message above this number of pending changes."
+ )
+;;;_ = allout-widgets-adjust-message-size-threshold 10000
+(defvar allout-widgets-adjust-message-size-threshold 10000
+ "Display \"Adjusting widgets\" message above this size of pending changes."
+ )
+;;;_ = allout-doing-exposure-undo-processor nil
+(defvar allout-undo-exposure-in-progress nil
+ "Maintained true during `allout-widgets-exposure-undo-processor'")
+;;;_ , Widget-specific outline text format
+;;;_ = allout-escaped-prefix-regexp
+(defvar allout-escaped-prefix-regexp ""
+ "*Regular expression for body text that would look like an item prefix if
+not altered with an escape sequence.")
+(make-variable-buffer-local 'allout-escaped-prefix-regexp)
+;;;_ , Widget element formatting
+;;;_ = allout-item-icon-keymap
+(defvar allout-item-icon-keymap
+ (let ((km (make-sparse-keymap)))
+ (dolist (digit '("0" "1" "2" "3"
+ "4" "5" "6" "7" "8" "9"))
+ (define-key km digit 'digit-argument))
+ (define-key km "-" 'negative-argument)
+;; (define-key km [(return)] 'allout-tree-expand-command)
+;; (define-key km [(meta return)] 'allout-toggle-torso-command)
+;; (define-key km [(down-mouse-1)] 'allout-item-button-click)
+;; (define-key km [(down-mouse-2)] 'allout-toggle-torso-event-command)
+ ;; Override underlying mouse-1 and mouse-2 bindings in icon territory:
+ (define-key km [(mouse-1)] (lambda () (interactive) nil))
+ (define-key km [(mouse-2)] (lambda () (interactive) nil))
+
+ ;; Catchall, handles actual keybindings, dynamically doing keymap lookups:
+ (define-key km [t] 'allout-item-icon-key-handler)
+
+ km)
+ "General tree-node key bindings.")
+;;;_ = allout-item-body-keymap
+(defvar allout-item-body-keymap
+ (let ((km (make-sparse-keymap))
+ (local-map (current-local-map)))
+;; (define-key km [(control return)] 'allout-tree-expand-command)
+;; (define-key km [(meta return)] 'allout-toggle-torso-command)
+ ;; XXX We need to reset this per buffer's mode; we do so in
+ ;; allout-widgets-mode.
+ (if local-map
+ (set-keymap-parent km local-map))
+
+ km)
+ "General key bindings for the text content of outline items.")
+(make-variable-buffer-local 'allout-item-body-keymap)
+;;;_ = allout-body-span-category
+(defvar allout-body-span-category nil
+ "Symbol carrying allout body-text overlay properties.")
+;;;_ = allout-cue-span-keymap
+(defvar allout-cue-span-keymap
+ (let ((km (make-sparse-keymap)))
+ (set-keymap-parent km allout-item-icon-keymap)
+ km)
+ "Keymap used in the item cue area - the space between the icon and
headline.")
+;;;_ = allout-escapes-category
+(defvar allout-escapes-category nil
+ "Symbol for category of text property used to hide escapes of prefix-like
+text in allout item bodies.")
+;;;_ = allout-guides-category
+(defvar allout-guides-category nil
+ "Symbol carrying allout icon-guides overlay properties.")
+;;;_ = allout-guides-span-category
+(defvar allout-guides-span-category nil
+ "Symbol carrying allout icon and guide lines overlay properties.")
+;;;_ = allout-icon-span-category
+(defvar allout-icon-span-category nil
+ "Symbol carrying allout icon and guide lines overlay properties.")
+;;;_ = allout-cue-span-category
+(defvar allout-cue-span-category nil
+ "Symbol carrying common properties of the space following the outline icon.
+
+\(That space is used to convey selected cues indicating body qualities,
+including things like:
+ - encryption '~'
+ - numbering '#'
+ - indirect reference '@'
+ - distinctive bullets - see `allout-distinctive-bullets-string'.\)")
+;;;_ = allout-span-to-category
+(defvar allout-span-to-category
+ '((:guides-span . allout-guides-span-category)
+ (:cue-span . allout-cue-span-category)
+ (:icon-span . allout-icon-span-category)
+ (:body-span . allout-body-span-category))
+ "Association list mapping span identifier to category identifier.")
+;;;_ = allout-trailing-category
+(defvar allout-trailing-category nil
+ "Symbol carrying common properties of an overlay's trailing newline.")
+;;;_ , Developer
+(defvar allout-widgets-last-decoration-timing nil
+ "Timing details for the last cooperative decoration action.
+
+This is maintained when `allout-widgets-time-decoration-activity' is set.
+
+The value is a list containing two elements:
+ - the elapsed time as a number of seconds
+ - the list of changes processed, a la `allout-widgets-changes-record'.
+
+When active, the value is revised each time automatic decoration activity
+happens in the buffer.")
+(make-variable-buffer-local 'allout-widgets-last-decoration-timing)
+;;;_ . mode hookup
+;;;_ > define-minor-mode allout-widgets-mode (arg)
+;;;###autoload
+(define-minor-mode allout-widgets-mode
+ "Allout-mode extension, providing graphical decoration of outline structure.
+
+This is meant to operate along with allout-mode, via `allout-mode-hook'.
+
+If optional argument ARG is greater than 0, enable.
+If optional argument ARG is less than 0, disable.
+Anything else, toggle between active and inactive.
+
+The graphics include:
+
+- guide lines connecting item bullet-icons with those of their subitems.
+
+- icons for item bullets, varying to indicate whether or not the item
+ has subitems, and if so, whether or not the item is expanded.
+
+- cue area between the bullet-icon and the start of the body headline,
+ for item numbering, encryption indicator, and distinctive bullets.
+
+The bullet-icon and guide line graphics provide keybindings and mouse
+bindings for easy outline navigation and exposure control, extending
+outline hot-spot navigation \(see `allout-mode')."
+
+ :lighter nil
+ :keymap nil
+
+ ;; define-minor-mode handles any provided argument according to emacs
+ ;; minor-mode conventions - '(elisp) Minor Mode Conventions' - and sets
+ ;; allout-widgets-mode accordingly *before* running the body code, so we
+ ;; cue on that.
+ (if allout-widgets-mode
+ ;; Activating:
+ (progn
+ (allout-add-resumptions
+ ;; XXX user may need say in line-truncation/hscrolling - an option
+ ;; that abstracts mode.
+ ;; truncate text lines to keep guide lines intact:
+ '(truncate-lines t)
+ ;; and enable autoscrolling to ease view of text
+ '(auto-hscroll-mode t)
+ '(line-move-ignore-fields t)
+ '(widget-push-button-prefix "")
+ '(widget-push-button-suffix "")
+ ;; allout-escaped-prefix-regexp depends on allout-regexp:
+ (list 'allout-escaped-prefix-regexp (concat "\\(\\\\\\)"
+ "\\(" allout-regexp
"\\)")))
+ (allout-add-resumptions
+ (list 'allout-widgets-tally allout-widgets-tally)
+ (list 'allout-widgets-escapes-sanitization-regexp-pair
+ (list (concat "\\(\n\\|\\`\\)"
+ allout-escaped-prefix-regexp
+ )
+ ;; Include everything but the escape symbol.
+ "\\1\\3"))
+ )
+
+ (add-hook 'after-change-functions 'allout-widgets-after-change-handler
+ nil t)
+
+ (allout-setup-text-properties)
+ (add-to-invisibility-spec '(allout-torso . t))
+ (add-to-invisibility-spec 'allout-escapes)
+
+ (if (current-local-map)
+ (set-keymap-parent allout-item-body-keymap (current-local-map)))
+
+ (add-hook 'allout-exposure-change-hook
+ 'allout-widgets-exposure-change-recorder nil 'local)
+ (add-hook 'allout-structure-added-hook
+ 'allout-widgets-additions-recorder nil 'local)
+ (add-hook 'allout-structure-deleted-hook
+ 'allout-widgets-deletions-recorder nil 'local)
+ (add-hook 'allout-structure-shifted-hook
+ 'allout-widgets-shifts-recorder nil 'local)
+ (add-hook 'allout-after-copy-or-kill-hook
+ 'allout-widgets-after-copy-or-kill-function nil 'local)
+
+ (add-hook 'before-change-functions
'allout-widgets-before-change-handler
+ nil 'local)
+ (add-hook 'post-command-hook 'allout-widgets-post-command-business
+ nil 'local)
+ (add-hook 'pre-command-hook 'allout-widgets-pre-command-business
+ nil 'local)
+
+ ;; init the widgets tally for debugging:
+ (if (not allout-widgets-tally)
+ (setq allout-widgets-tally (make-hash-table
+ :test 'eq :weakness 'key)))
+ ;; add tally count display on minor-mode-alist just after
+ ;; allout-mode entry.
+ ;; (we use ternary condition form to keep condition simple for
deletion.)
+ (let* ((mode-line-entry '(allout-widgets-mode-inhibit ""
+ (:eval
(allout-widgets-tally-string))))
+ (associated (assoc (car mode-line-entry) minor-mode-alist))
+ ;; need location for it only if not already present:
+ (after (and (not associated)
+ (memq (assq 'allout-mode minor-mode-alist)
minor-mode-alist))))
+ (if after
+ (rplacd after (cons mode-line-entry (cdr after)))))
+ (allout-widgets-prepopulate-buffer)
+ t)
+ ;; Deactivating:
+ (let ((inhibit-read-only t)
+ (was-modified (buffer-modified-p)))
+
+ (allout-widgets-undecorate-region (point-min)(point-max))
+ (remove-from-invisibility-spec '(allout-torso . t))
+ (remove-from-invisibility-spec 'allout-escapes)
+
+ (remove-hook 'after-change-functions
+ 'allout-widgets-after-change-handler 'local)
+ (remove-hook 'allout-exposure-change-hook
+ 'allout-widgets-exposure-change-recorder 'local)
+ (remove-hook 'allout-structure-added-hook
+ 'allout-widgets-additions-recorder 'local)
+ (remove-hook 'allout-structure-deleted-hook
+ 'allout-widgets-deletions-recorder 'local)
+ (remove-hook 'allout-structure-shifted-hook
+ 'allout-widgets-shifts-recorder 'local)
+ (remove-hook 'allout-after-copy-or-kill-hook
+ 'allout-widgets-after-copy-or-kill-function 'local)
+ (remove-hook 'before-change-functions
+ 'allout-widgets-before-change-handler 'local)
+ (remove-hook 'post-command-hook
+ 'allout-widgets-post-command-business 'local)
+ (remove-hook 'pre-command-hook
+ 'allout-widgets-pre-command-business 'local)
+ (assq-delete-all 'allout-widgets-mode-inhibit minor-mode-alist)
+ (set-buffer-modified-p was-modified))))
+;;;_ > allout-widgets-mode-off
+(defun allout-widgets-mode-off ()
+ "Explicitly disable allout-widgets-mode."
+ (allout-widgets-mode -1))
+;;;_ > allout-widgets-mode-off
+(defun allout-widgets-mode-on ()
+ "Explicitly disable allout-widgets-mode."
+ (allout-widgets-mode 1))
+;;;_ > allout-setup-text-properties ()
+(defun allout-setup-text-properties ()
+ "Configure category and literal text properties."
+
+ ;; XXX body - before-change, entry, keymap
+
+ (setplist 'allout-guides-span-category nil)
+ (put 'allout-guides-span-category
+ 'modification-hooks '(allout-graphics-modification-handler))
+ (put 'allout-guides-span-category 'local-map allout-item-icon-keymap)
+ (put 'allout-guides-span-category 'mouse-face widget-button-face)
+ (put 'allout-guides-span-category 'field 'structure)
+;; (put 'allout-guides-span-category 'face 'widget-button)
+
+ (setplist 'allout-icon-span-category
+ (allout-widgets-copy-list (symbol-plist
+ 'allout-guides-span-category)))
+ (put 'allout-icon-span-category 'field 'structure)
+
+ ;; XXX for body text we're instead going to use the buffer-wide
+ ;; resources, like before/after-change-functions hooks and the
+ ;; buffer's key map. that way we won't have to do painful provisions
+ ;; to fixup things after edits, catch outlier interstitial
+ ;; characters, like newline and empty lines after hidden subitems,
+ ;; etc.
+ (setplist 'allout-body-span-category nil)
+ (put 'allout-body-span-category 'evaporate t)
+ (put 'allout-body-span-category 'local-map allout-item-body-keymap)
+ ;;(put 'allout-body-span-category
+ ;; 'modification-hooks '(allout-body-modification-handler))
+ ;;(put 'allout-body-span-category 'field 'body)
+
+ (setplist 'allout-cue-span-category nil)
+ (put 'allout-cue-span-category 'evaporate t)
+ (put 'allout-cue-span-category
+ 'modification-hooks '(allout-body-modification-handler))
+ (put 'allout-cue-span-category 'local-map allout-cue-span-keymap)
+ (put 'allout-cue-span-category 'mouse-face widget-button-face)
+ (put 'allout-cue-span-category 'pointer 'arrow)
+ (put 'allout-cue-span-category 'field 'structure)
+
+ (setplist 'allout-trailing-category nil)
+ (put 'allout-trailing-category 'evaporate t)
+ (put 'allout-trailing-category 'local-map allout-item-body-keymap)
+
+ (setplist 'allout-escapes-category nil)
+ (put 'allout-escapes-category 'invisible 'allout-escapes)
+ (put 'allout-escapes-category 'evaporate t))
+;;;_ > allout-widgets-prepopulate-buffer ()
+(defun allout-widgets-prepopulate-buffer ()
+ "Step over the current buffers exposed items to do initial widgetizing."
+ (if (not allout-widgets-mode-inhibit)
+ (save-excursion
+ (goto-char (point-min))
+ (while (allout-next-visible-heading 1)
+ (when (not (widget-at (point)))
+ (allout-get-or-create-item-widget))))))
+;;;_ . settings context
+;;;_ = allout-container-item
+(defvar allout-container-item-widget nil
+ "A widget for the current outline's overarching container as an item.
+
+The item has settings \(of the file/connection\) and maybe a body, but no
+icon/bullet.")
+(make-variable-buffer-local 'allout-container-item-widget)
+;;;_ . Hooks and hook helpers
+;;;_ , major command-loop business:
+;;;_ > allout-widgets-pre-command-business (&optional recursing)
+(defun allout-widgets-pre-command-business (&optional recursing)
+ "Handle actions pending before allout-mode activity."
+)
+;;;_ > allout-widgets-post-command-business (&optional recursing)
+(defun allout-widgets-post-command-business (&optional recursing)
+ "Handle actions pending after any allout-mode commands.
+
+Optional RECURSING is for internal use, to limit recursion."
+ ;; - check changed text for nesting discontinuities and escape anything
+ ;; that's: (1) asterisks at bol or (2) excessively nested.
+ (condition-case failure
+
+ (when (and (boundp 'allout-mode) allout-mode)
+
+ (if allout-widgets-unset-inhibit-read-only
+ (setq inhibit-read-only nil
+ allout-widgets-unset-inhibit-read-only nil))
+
+ (when allout-widgets-reenable-before-change-handler
+ (add-hook 'before-change-functions
+ 'allout-widgets-before-change-handler
+ nil 'local)
+ (setq allout-widgets-reenable-before-change-handler nil))
+
+ (when (or allout-widgets-undo-exposure-record
+ allout-widgets-changes-record)
+ (let* ((debug-on-signal t)
+ (debug-on-error t)
+ ;; inhibit recording new undo records when processing
+ ;; effects of undo-exposure:
+ (debugger 'allout-widgets-hook-error-handler)
+ (adjusting-message " Adjusting widgets...")
+ (replaced-message (allout-widgets-adjusting-message
+ adjusting-message))
+ (start-time (current-time)))
+
+ (if allout-widgets-undo-exposure-record
+ ;; inhibit undo recording iff undoing exposure stuff.
+ ;; XXX we might need to inhibit per respective
+ ;; change-record, rather than assuming that some undo
+ ;; activity during a command is all undo activity.
+ (let ((buffer-undo-list t))
+ (allout-widgets-exposure-undo-processor)
+ (allout-widgets-changes-dispatcher))
+ (allout-widgets-exposure-undo-processor)
+ (allout-widgets-changes-dispatcher))
+
+ (if allout-widgets-time-decoration-activity
+ (setq allout-widgets-last-decoration-timing
+ (list (allout-elapsed-time-seconds (current-time)
+ start-time)
+ allout-widgets-changes-record)))
+
+ (setq allout-widgets-changes-record nil)
+
+ (if replaced-message
+ (if (stringp replaced-message)
+ (message replaced-message)
+ (message "")))))
+
+ ;; Detect undecorated items, eg during isearch into previously
+ ;; unexposed topics, and decorate "economically". Some
+ ;; undecorated stuff is often exposed, to reduce lag, but the
+ ;; item containing the cursor is decorated. We constrain
+ ;; recursion to avoid being trapped by unexpectedly undecoratable
+ ;; items.
+ (when (and (not recursing)
+ (not (allout-current-decorated-p))
+ (or (not (equal (allout-depth) 0))
+ (not allout-container-item-widget)))
+ (let ((buffer-undo-list t))
+ (allout-widgets-exposure-change-recorder
+ allout-recent-prefix-beginning allout-recent-prefix-end nil)
+ (allout-widgets-post-command-business 'recursing)))
+
+ ;; Detect and rectify fouled outline structure - decorated item
+ ;; not at beginning of line.
+ (let ((this-widget (or (widget-at (point))
+ ;; XXX we really should be checking across
+ ;; edited span, not just point and point+1
+ (and (not (eq (point) (point-max)))
+ (widget-at (1+ (point))))))
+ inserted-at)
+ (save-excursion
+ (if (and this-widget
+ (goto-char (widget-get this-widget :from))
+ (not (bolp)))
+ (if (not
+ (condition-case err
+ (yes-or-no-p
+ (concat "Misplaced item won't be recognizable "
+ " as part of outline - rectify? "))
+ (quit nil)))
+ (progn
+ (if (allout-hidden-p (max (1- (point)) 1))
+ (save-excursion
+ (goto-char (max (1- (point)) 1))
+ (allout-show-to-offshoot)))
+ (allout-widgets-undecorate-item this-widget))
+ ;; expose any hidden intervening items, so resulting
+ ;; position is clear:
+ (setq inserted-at (point))
+ (allout-unprotected (insert-before-markers "\n"))
+ (forward-char -1)
+ ;; ensure the inserted newline is visible:
+ (allout-flag-region inserted-at (1+ inserted-at) nil)
+ (allout-widgets-post-command-business 'recursing)
+ (message (concat "outline structure corrected - item"
+ " moved to beginning of new line"))
+ ;; preserve cursor position in some cases:
+ (if (and inserted-at
+ (> (point) inserted-at))
+ (forward-char -1)))))))
+
+ (error
+ ;; zero work list so we don't get stuck futily retrying.
+ ;; error recording done by allout-widgets-hook-error-handler.
+ (setq allout-widgets-changes-record nil))))
+;;;_ , major change handlers:
+;;;_ > allout-widgets-before-change-handler
+(defun allout-widgets-before-change-handler (beg end)
+ "Business to be done before changes in a widgetized allout outline."
+ ;; protect against unruly edits to structure:
+ (cond
+ (undo-in-progress (when (eq (get-text-property beg 'category)
+ 'allout-icon-span-category)
+ (save-excursion
+ (goto-char beg)
+ (let* ((item-widget (allout-get-item-widget)))
+ (if item-widget
+ (allout-widgets-exposure-undo-recorder
+ item-widget))))))
+ (inhibit-read-only t)
+ ((not (and (boundp 'allout-mode) allout-mode)) t)
+ ((equal this-command 'quoted-insert) t)
+ ((not (text-property-any beg (if (equal end beg)
+ (min (1+ beg) (point-max))
+ end)
+ 'field 'structure))
+ t)
+ ((yes-or-no-p "Unruly edit of outline structure - allow? ")
+ (setq allout-widgets-unset-inhibit-read-only (not inhibit-read-only)
+ inhibit-read-only t))
+ (t
+ ;; tell the allout-widgets-post-command-business to reestablish the hook:
+ (setq allout-widgets-reenable-before-change-handler t)
+ ;; and raise an error to prevent the edit (and disable the hook):
+ (error
+ (substitute-command-keys allout-structure-unruly-deletion-message)))))
+;;;_ > allout-widgets-after-change-handler
+(defun allout-widgets-after-change-handler (beg end prelength)
+ "Reconcile what needs to be reconciled for allout widgets after edits."
+ )
+;;;_ > allout-current-decorated-p ()
+(defun allout-current-decorated-p ()
+ "True if the current item is not decorated"
+ (save-excursion
+ (if (allout-back-to-current-heading)
+ (if (> allout-recent-depth 0)
+ (and (allout-get-item-widget) t)
+ allout-container-item-widget))))
+
+;;;_ > allout-widgets-hook-error-handler
+(defun allout-widgets-hook-error-handler (mode args)
+ "Process errors which occurred in the course of command hook operation.
+
+We store a backtrace of the error information in the variable,
+`allout-widgets-last-hook-error', unset the error handlers, and
+reraise the error, so that processing continues to the
+encompassing condition-case."
+ ;; first deconstruct special error environment so errors here propagate
+ ;; to encompassing condition-case:
+ (setq debugger 'debug
+ debug-on-error nil
+ debug-on-signal nil)
+ (let* ((bt (with-output-to-string (backtrace)))
+ (this "allout-widgets-hook-error-handler")
+ (header
+ (format "allout-widgets-last-hook-error stored, %s/%s %s %s"
+ this mode args
+ (format-time-string "%e-%b-%Y %r" (current-time)))))
+ ;; post to *Messages* then immediately replace with more compact notice:
+ (message "%s" (setq allout-widgets-last-hook-error
+ (format "%s:\n%s" header bt)))
+ (message header) (sit-for allout-widgets-hook-error-post-time)
+ ;; reraise the error, or one concerning this function if unexpected:
+ (if (equal mode 'error)
+ (apply 'signal args)
+ (error "%s: unexpected mode, %s %s" this mode args))))
+;;;_ > allout-widgets-changes-exceed-threshold-p ()
+(defun allout-widgets-adjusting-message (message)
+ "Post MESSAGE when pending are likely to make a big enough delay.
+
+If posting of the MESSAGE is warranted and there already is a
+`current-message' in the minibuffer, the MESSAGE is appended to
+the current one, and the previously pending `current-message' is
+returned for later posting on completion.
+
+If posting of the MESSAGE is warranted, but no `current-message'
+is pending, then t is returned to indicate that case.
+
+If posting of the MESSAGE is not warranted, then nil is returned.
+
+See `allout-widgets-adjust-message-length-threshold',
+`allout-widgets-adjust-message-size-threshold' for message
+posting threshold criteria."
+ (if (or (> (length allout-widgets-changes-record)
+ allout-widgets-adjust-message-length-threshold)
+ ;; for size, use distance from start of first to end of last:
+ (let ((min (point-max))
+ (max 0)
+ first second)
+ (mapc (function (lambda (entry)
+ (if (eq :undone-exposure (car entry))
+ nil
+ (setq first (cadr entry)
+ second (caddr entry))
+ (if (< (min first second) min)
+ (setq min (min first second)))
+ (if (> (max first second) max)
+ (setq max (max first second))))))
+ allout-widgets-changes-record)
+ (> (- max min) allout-widgets-adjust-message-size-threshold)))
+ (let ((prior (current-message)))
+ (message (if prior (concat prior " - " message) message))
+ (or prior t))))
+;;;_ > allout-widgets-changes-dispatcher ()
+(defun allout-widgets-changes-dispatcher ()
+ "Dispatch CHANGES-RECORD items to respective widgets change processors."
+
+ (if (not allout-widgets-mode-inhibit)
+ (let* ((changes-record allout-widgets-changes-record)
+ (changes-pending (and changes-record t))
+ entry
+ exposures
+ additions
+ deletions
+ shifts)
+
+ (when changes-pending
+ (while changes-record
+ (setq entry (pop changes-record))
+ (case (car entry)
+ (:exposed (push entry exposures))
+ (:added (push entry additions))
+ (:deleted (push entry deletions))
+ (:shifted (push entry shifts))))
+
+ (if exposures
+ (allout-widgets-exposure-change-processor exposures))
+ (if additions
+ (allout-widgets-additions-processor additions))
+ (if deletions
+ (allout-widgets-deletions-processor deletions))
+ (if shifts
+ (allout-widgets-shifts-processor shifts))))
+ (when (not (equal allout-widgets-mode-inhibit 'undecorated))
+ (allout-widgets-undecorate-region (point-min)(point-max))
+ (setq allout-widgets-mode-inhibit 'undecorated))))
+;;;_ > allout-widgets-exposure-change-recorder (from to flag)
+(defun allout-widgets-exposure-change-recorder (from to flag)
+ "Record allout exposure changes for tracking during post-command processing.
+
+Records changes in `allout-widgets-changes-record'."
+ (push (list :exposed from to flag) allout-widgets-changes-record))
+;;;_ > allout-widgets-exposure-change-processor (changes)
+(defun allout-widgets-exposure-change-processor (changes)
+ "Widgetize and adjust item widgets tracking allout outline exposure changes.
+
+Generally invoked via `allout-exposure-change-hook'."
+
+ (let ((changes (sort changes (function (lambda (this next)
+ (< (cadr this) (cadr next))))))
+ ;; have to distinguish between concealing and exposing so that, eg,
+ ;; `allout-expose-topic's mix is handled properly.
+ handled-expose
+ handled-conceal
+ covered
+ deactivate-mark)
+
+ (dolist (change changes)
+ (let (handling
+ (from (cadr change))
+ bucket got
+ (to (caddr change))
+ (flag (cadddr change))
+ parent)
+
+ ;; swap from and to:
+ (if (< to from) (setq bucket to
+ to from
+ from bucket))
+
+ ;; have we already handled exposure changes in this region?
+ (setq handling (if flag 'handled-conceal 'handled-expose)
+ got (allout-range-overlaps from to (symbol-value handling))
+ covered (car got))
+ (set handling (cadr got))
+
+ (when (not covered)
+ (save-excursion
+ (goto-char from)
+ (cond
+
+ ;; collapsing:
+ (flag
+ (allout-widgets-undecorate-region from to)
+ (allout-beginning-of-current-line)
+ (let ((widget (allout-get-item-widget)))
+ (if (not widget)
+ (allout-get-or-create-item-widget)
+ (widget-apply widget :redecorate))))
+
+ ;; expanding:
+ (t
+ (while (< (point) to)
+ (allout-beginning-of-current-line)
+ (setq parent (allout-get-item-widget))
+ (if (not parent)
+ (setq parent (allout-get-or-create-item-widget))
+ (widget-apply parent :redecorate))
+ (allout-next-visible-heading 1)
+ (if (widget-get parent :has-subitems)
+ (allout-redecorate-visible-subtree parent))
+ (if (> (point) to)
+ ;; subtree may be well beyond to - incorporate in ranges:
+ (setq handled-expose
+ (allout-range-overlaps from (point) handled-expose)
+ covered (car handled-expose)
+ handled-expose (cadr handled-expose)))
+ (allout-next-visible-heading 1))))))))))
+
+;;;_ > allout-widgets-additions-recorder (from to)
+(defun allout-widgets-additions-recorder (from to)
+ "Record allout item additions for tracking during post-command processing.
+
+Intended for use on `allout-structure-added-hook'.
+
+FROM point at the start of the first new item and TO is point at the start
+of the last one.
+
+Records changes in `allout-widgets-changes-record'."
+ (push (list :added from to) allout-widgets-changes-record))
+;;;_ > allout-widgets-additions-processor (changes)
+(defun allout-widgets-additions-processor (changes)
+ "Widgetize and adjust items tracking allout outline structure additions.
+
+Dispatched by `allout-widgets-post-command-business' in response to
+:added entries recorded by `allout-widgets-additions-recorder'."
+ (save-excursion
+ (let (handled
+ covered)
+ (dolist (change changes)
+ (let ((from (cadr change))
+ bucket
+ (to (caddr change)))
+ (if (< to from) (setq bucket to to from from bucket))
+ ;; have we already handled exposure changes in this region?
+ (setq handled (allout-range-overlaps from to handled)
+ covered (car handled)
+ handled (cadr handled))
+ (when (not covered)
+ (goto-char from)
+ ;; Prior sibling and parent can both be affected.
+ (if (allout-ascend)
+ (allout-redecorate-visible-subtree
+ (allout-get-or-create-item-widget 'redecorate)))
+ (if (< (point) from)
+ (goto-char from))
+ (while (and (< (point) to) (not (eobp)))
+ (allout-beginning-of-current-line)
+ (allout-redecorate-visible-subtree
+ (allout-get-or-create-item-widget))
+ (allout-next-visible-heading 1))
+ (if (> (point) to)
+ ;; subtree may be well beyond to - incorporate in ranges:
+ (setq handled (allout-range-overlaps from (point) handled)
+ covered (car handled)
+ handled (cadr handled)))))))))
+
+;;;_ > allout-widgets-deletions-recorder (depth from)
+(defun allout-widgets-deletions-recorder (depth from)
+ "Record allout item deletions for tracking during post-command processing.
+
+Intended for use on `allout-structure-deleted-hook'.
+
+DEPTH is the depth of the deleted subtree, and FROM is the point from which
+the subtree was deleted.
+
+Records changes in `allout-widgets-changes-record'."
+ (push (list :deleted depth from) allout-widgets-changes-record))
+;;;_ > allout-widgets-deletions-processor (changes)
+(defun allout-widgets-deletions-processor (changes)
+ "Adjust items tracking allout outline structure deletions.
+
+Dispatched by `allout-widgets-post-command-business' in response to
+:deleted entries recorded by `allout-widgets-deletions-recorder'."
+ (save-excursion
+ (dolist (change changes)
+ (let ((depth (cadr change))
+ (from (caddr change)))
+ (goto-char from)
+ (when (allout-previous-visible-heading 1)
+ (if (> depth 1)
+ (allout-ascend-to-depth (1- depth)))
+ (allout-redecorate-visible-subtree
+ (allout-get-or-create-item-widget 'redecorate)))))))
+
+;;;_ > allout-widgets-shifts-recorder (shifted-amount at)
+(defun allout-widgets-shifts-recorder (shifted-amount at)
+ "Record outline subtree shifts for tracking during post-command processing.
+
+Intended for use on `allout-structure-shifted-hook'.
+
+SHIFTED-AMOUNT is the depth change and AT is the point at the start of the
+subtree that's been shifted.
+
+Records changes in `allout-widgets-changes-record'."
+ (push (list :shifted shifted-amount at) allout-widgets-changes-record))
+;;;_ > allout-widgets-shifts-processor (changes)
+(defun allout-widgets-shifts-processor (changes)
+ "Widgetize and adjust items tracking allout outline structure additions.
+
+Dispatched by `allout-widgets-post-command-business' in response to
+:shifted entries recorded by `allout-widgets-shifts-recorder'."
+ (save-excursion
+ (dolist (change changes)
+ (goto-char (caddr change))
+ (allout-ascend)
+ (allout-redecorate-visible-subtree))))
+;;;_ > allout-widgets-after-copy-or-kill-function ()
+(defun allout-widgets-after-copy-or-kill-function ()
+ "Do allout-widgets processing of text just placed in the kill ring.
+
+Intended for use on allout-after-copy-or-kill-hook."
+ (if (car kill-ring)
+ (setcar kill-ring (allout-widgets-undecorate-text (car kill-ring)))))
+
+;;;_ > allout-widgets-exposure-undo-recorder (widget from-state)
+(defun allout-widgets-exposure-undo-recorder (widget)
+ "Record outline exposure undo for tracking during post-command processing.
+
+Intended for use by `allout-graphics-modification-handler'.
+
+WIDGET is the widget being changed.
+
+Records changes in `allout-widgets-changes-record'."
+ ;; disregard the events if we're currently processing them.
+ (if (not allout-undo-exposure-in-progress)
+ (push widget allout-widgets-undo-exposure-record)))
+;;;_ > allout-widgets-exposure-undo-processor ()
+(defun allout-widgets-exposure-undo-processor ()
+ "Adjust items tracking undo of allout outline structure exposure.
+
+Dispatched by `allout-widgets-post-command-business' in response to
+:undone-exposure entries recorded by `allout-widgets-exposure-undo-recorder'."
+ (let* ((allout-undo-exposure-in-progress t)
+ ;; inhibit undo recording while twiddling exposure to track undo:
+ (widgets allout-widgets-undo-exposure-record)
+ widget widget-start-marker widget-end-marker
+ from-state icon-start-point to-state
+ handled covered)
+ (setq allout-widgets-undo-exposure-record nil)
+ (save-excursion
+ (dolist (widget widgets)
+ (setq widget-start-marker (widget-get widget :from)
+ widget-end-marker (widget-get widget :to)
+ from-state (widget-get widget :icon-state)
+ icon-start-point (widget-apply widget :actual-position
+ :icon-start)
+ to-state (get-text-property icon-start-point
+ :icon-state))
+ (setq handled (allout-range-overlaps widget-start-marker
+ widget-end-marker
+ handled)
+ covered (car handled)
+ handled (cadr handled))
+ (when (not covered)
+ (goto-char (widget-get widget :from))
+ (when (not (allout-hidden-p))
+ ;; adjust actual exposure to that of to-state viz from-state
+ (cond ((and (eq to-state 'closed) (eq from-state 'opened))
+ (allout-hide-current-subtree)
+ (allout-decorate-item-and-context widget))
+ ((and (eq to-state 'opened) (eq from-state 'closed))
+ (save-excursion
+ (dolist
+ (expose-to (allout-chart-exposure-contour-by-icon))
+ (goto-char expose-to)
+ (allout-show-to-offshoot)))))))))))
+;;;_ > allout-chart-exposure-contour-by-icon (&optional from-depth)
+(defun allout-chart-exposure-contour-by-icon (&optional from-depth)
+ "Return points of subtree items to which exposure should be extended.
+
+The qualifying items are ones with a widget icon that is in the closed or
+empty state, or items with undecorated subitems.
+
+The resulting list of points is in reverse order.
+
+Optional FROM-DEPTH is for internal use."
+ ;; During internal recursion, we return a pair: (at-end . result)
+ ;; Otherwise we just return the result.
+ (let ((from-depth from-depth)
+ start-point
+ at-end level-depth
+ this-widget
+ got subgot)
+ (if from-depth
+ (setq level-depth (allout-depth))
+ ;; at containing item:
+ (setq start-point (point))
+ (setq from-depth (allout-depth))
+ (setq at-end (not (allout-next-heading))
+ level-depth allout-recent-depth))
+
+ ;; traverse the level, recursing on deeper levels:
+ (while (and (not at-end)
+ (> allout-recent-depth from-depth)
+ (setq this-widget (allout-get-item-widget)))
+ (if (< level-depth allout-recent-depth)
+ ;; recurse:
+ (progn
+ (setq subgot (allout-chart-exposure-contour-by-icon level-depth)
+ at-end (car subgot)
+ subgot (cdr subgot))
+ (if subgot (setq got (append subgot got))))
+ ;; progress at this level:
+ (when (memq (widget-get this-widget :icon-state) '(closed empty))
+ (push (point) got)
+ (allout-end-of-subtree))
+ (setq at-end (not (allout-next-heading)))))
+
+ ;; tailor result depending on whether or not we're a recursion:
+ (if (not start-point)
+ (cons at-end got)
+ (goto-char start-point)
+ got)))
+;;;_ > allout-range-overlaps (from to ranges)
+(defun allout-range-overlaps (from to ranges)
+ "Return a pair indicating overlap of FROM and TO subtree range in RANGES.
+
+First element of result indicates whether candadate range FROM, TO
+overlapped any of the existing ranges.
+
+Second element of result is a new version of RANGES incorporating the
+candidate range with overlaps consolidated.
+
+FROM and TO must be in increasing order, as must be the pairs in RANGES."
+ ;; to append to the end: (rplacd next-to-last-cdr (list 'f))
+ (let (new-ranges
+ entry
+ ;; the start of the range that includes the candidate from:
+ included-from
+ ;; the end of the range that includes the candidate to:
+ included-to
+ ;; the candidates were inserted:
+ done)
+ (while (and ranges (not done))
+ (setq entry (car ranges)
+ ranges (cdr ranges))
+
+ (cond
+
+ (included-from
+ ;; some entry included the candidate from.
+ (cond ((> (car entry) to)
+ ;; current entry exceeds end of candidate range - done.
+ (push (list included-from to) new-ranges)
+ (push entry new-ranges)
+ (setq included-to to
+ done t))
+ ((>= (cadr entry) to)
+ ;; current entry includes end of candidate range - done.
+ (push (list included-from (cadr entry)) new-ranges)
+ (setq included-to (cadr entry)
+ done t))
+ ;; current entry contained in candidate range - ditch, continue:
+ (t nil)))
+
+ ((> (car entry) to)
+ ;; current entry start exceeds candidate end - done, placed as new
entry
+ (push (list from to) new-ranges)
+ (push entry new-ranges)
+ (setq included-to to
+ done t))
+
+ ((>= (car entry) from)
+ ;; current entry start is above candidate start, but not above
+ ;; candidate end (by prior case).
+ (setq included-from from)
+ ;; now we have to check on whether this entry contains to, or continue:
+ (when (>= (cadr entry) to)
+ ;; current entry contains only candidate end - done:
+ (push (list included-from (cadr entry)) new-ranges)
+ (setq included-to (cadr entry)
+ done t))
+ ;; otherwise, we will continue to look for placement of candidate end.
+ )
+
+ ((>= (cadr entry) to)
+ ;; current entry properly contains candidate range.
+ (push entry new-ranges)
+ (setq included-from (car entry)
+ included-to (cadr entry)
+ done t))
+
+ ((>= (cadr entry) from)
+ ;; current entry contains start of candidate range.
+ (setq included-from (car entry)))
+
+ (t
+ ;; current entry is below the candidate range.
+ (push entry new-ranges))))
+
+ (cond ((and included-from included-to)
+ ;; candidates placed.
+ nil)
+ ((not (or included-from included-to))
+ ;; candidates found no place, must be at the end:
+ (push (list from to) new-ranges))
+ (included-from
+ ;; candidate start placed but end not:
+ (push (list included-from to) new-ranges))
+ ;; might be included-to and not included-from, indicating new entry.
+ )
+ (setq new-ranges (nreverse new-ranges))
+ (if ranges (setq new-ranges (append new-ranges ranges)))
+ (list (if included-from t) new-ranges)))
+;;;_ > allout-test-range-overlaps ()
+(defun allout-test-range-overlaps ()
+ "allout-range-overlaps unit tests."
+ (let* (ranges
+ got
+ (try (lambda (from to)
+ (setq got (allout-range-overlaps from to ranges))
+ (setq ranges (cadr got))
+ got)))
+;; ;; biggie:
+;; (setq ranges nil)
+;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall
+;; ;; ~ 13 seconds for doing repeated funcall
+;; (message "time-trial: %s, resulting size %s"
+;; (time-trial
+;; '(let ((size 10000)
+;; doing)
+;; (random t)
+;; (dotimes (count size)
+;; (setq doing (random size))
+;; (funcall try doing (+ doing (random 5)))
+;; ;;(list doing (+ doing (random 5)))
+;; )))
+;; (length ranges))
+;; (sit-for 2)
+
+ ;; fresh:
+ (setq ranges nil)
+ (assert (equal (funcall try 3 5) '(nil ((3 5)))))
+ ;; add range at end:
+ (assert (equal (funcall try 10 12) '(nil ((3 5) (10 12)))))
+ ;; add range at beginning:
+ (assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12)))))
+ ;; insert range somewhere in the middle:
+ (assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12)))))
+ ;; consolidate some:
+ (assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12)))))
+ ;; add more:
+ (assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17)))))
+ ;; add more:
+ (assert (equal (funcall try 20 22)
+ '(nil ((1 2) (3 9) (10 12) (15 17) (20 22)))))
+ ;; encompass more:
+ (assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22)))))
+ ;; encompass all:
+ (assert (equal (funcall try 2 25) '(t ((1 25)))))
+
+ ;; fresh slate:
+ (setq ranges nil)
+ (assert (equal (funcall try 20 25) '(nil ((20 25)))))
+ (assert (equal (funcall try 30 35) '(nil ((20 25) (30 35)))))
+ (assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35)))))
+ (assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35)))))
+ (assert (equal (funcall try 10 30) '(t ((10 35)))))
+ (assert (equal (funcall try 5 6) '(nil ((5 6) (10 35)))))
+ (assert (equal (funcall try 2 100) '(t ((2 100)))))
+
+ (setq ranges nil)
+ ))
+;;;_ > allout-widgetize-buffer (&optional doing)
+(defun allout-widgetize-buffer (&optional doing)
+ "EXAMPLE FUNCTION. Widgetize items in buffer using allout-chart-subtree.
+
+We economize by just focusing on the first of local-maximum depth siblings.
+
+Optional DOING is for internal use - a chart of the current level, for
+recursive operation."
+
+ (interactive)
+ (if (not doing)
+
+ (save-excursion
+ (goto-char (point-min))
+ ;; Construct the chart by scanning the siblings:
+ (dolist (top-level-sibling (allout-chart-siblings))
+ (goto-char top-level-sibling)
+ (let ((subchart (allout-chart-subtree)))
+ (if subchart
+ (allout-widgetize-buffer subchart)))))
+
+ ;; save-excursion was done on recursion entry, not necessary here.
+ (let (have-sublists)
+ (dolist (sibling doing)
+ (when (listp sibling)
+ (setq have-sublists t)
+ (allout-widgetize-buffer sibling)))
+ (when (and (not have-sublists) (not (widget-at (car doing))))
+ (goto-char (car doing))
+ (allout-get-or-create-item-widget)))))
+
+;;;_ : Item widget and constructors
+
+;;;_ $ allout-item-widget
+(define-widget 'allout-item-widget 'default
+ "A widget presenting an allout outline item."
+
+ 'button nil
+ ;; widget-field-at respects this to get item if 'field is unused.
+ ;; we don't use field to avoid collision with end-of-line, etc, on which
+ ;; allout depends.
+ 'real-field nil
+
+ ;; data fields:
+
+
+ ;; tailor the widget for a specific item
+ :create 'allout-decorate-item-and-context
+ :value-delete 'allout-widgets-undecorate-item
+ ;; Not Yet Converted (from original, tree-widget stab)
+ :expander 'allout-tree-event-dispatcher ; get children when nil :args
+ :expander-p 'identity ; always engage the :expander
+ :action 'allout-tree-widget-action
+ ;; :notify "when item changes"
+
+ ;; force decoration of item but not context, unless already done this tick:
+ :redecorate 'allout-redecorate-item
+ :last-decorated-tick nil
+ ;; recognize the actual situation of the item's text:
+ :parse-item 'allout-parse-item-at-point
+ ;; decorate the entirety of the item, sans offspring:
+ :decorate-item-span 'allout-decorate-item-span
+ ;; decorate the various item elements:
+ :decorate-guides 'allout-decorate-item-guides
+ :decorate-icon 'allout-decorate-item-icon
+ :decorate-cue 'allout-decorate-item-cue
+ :decorate-body 'allout-decorate-item-body
+ :actual-position 'allout-item-actual-position
+
+ ;; Layout parameters:
+ :is-container nil ; is this actually the encompassing file/connection?
+
+ :from nil ; item beginning - marker
+ :to nil ; item end - marker
+ :span-overlay nil ; overlay by which actual postion is determined
+
+ ;; also serves as guide-end:
+ :icon-start nil
+ :icon-end nil
+ :distinctive-start nil
+ ;; also serves as cue-start:
+ :distinctive-end nil
+ ;; also serves as cue-end:
+ :body-start nil
+ :body-end nil
+ :depth nil
+ :has-subitems nil
+ :was-has-subitems 'init
+ :expanded nil
+ :was-expanded 'init
+ :brief nil
+ :was-brief 'init
+
+ :does-encrypt nil ; pending encryption when :is-encrypted false.
+ :is-encrypted nil
+
+ ;; the actual location of the item text:
+ :location 'allout-item-location
+
+ :button-keymap allout-item-icon-keymap ; XEmacs
+ :keymap allout-item-icon-keymap ; Emacs
+
+ ;; Element regions:
+ :guides-span nil
+ :icon-span nil
+ :cue-span nil
+ :bullet nil
+ :was-bullet nil
+ :body-span nil
+
+ :body-brevity-p 'allout-body-brevity-p
+
+ ;; :guide-column-flags indicate (in reverse order) whether or not the
+ ;; item's ancestor at the depth corresponding to the column has a
+ ;; subsequent sibling - ie, whether or not the corresponding column needs
+ ;; a descender line to connect that ancestor with its sibling.
+ :guide-column-flags nil
+ :was-guide-column-flags 'init
+
+ ;; ie, has subitems:
+ :populous-p 'allout-item-populous-p
+ :help-echo 'allout-tree-widget-help-echo
+ )
+;;;_ > allout-new-item-widget ()
+(defsubst allout-new-item-widget ()
+ "create a new item widget, not yet situated anywhere."
+ (if allout-widgets-maintain-tally
+ ;; all the extra overhead is incurred only when doing the
+ ;; maintenance, except the condition, which can't be avoided.
+ (let ((widget (widget-convert 'allout-item-widget)))
+ (puthash widget nil allout-widgets-tally)
+ widget)
+ (widget-convert 'allout-item-widget)))
+;;;_ : Item decoration
+;;;_ > allout-decorate-item-and-context (item-widget &optional redecorate
+;;; blank-container parent)
+(defun allout-decorate-item-and-context (item-widget &optional redecorate
+ blank-container parent)
+ "Create or adjust widget decorations for ITEM-WIDGET and neighbors at point.
+
+The neighbors include its siblings and parent.
+
+ITEM-WIDGET can be a created or converted allout-item-widget.
+
+If you're only trying to get or create a widget for an item, use
+`allout-get-or-create-item-widget'. If you have the item-widget, applying
+:redecorate will do the right thing.
+
+Optional BLANK-CONTAINER is for internal use. It is used to fabricate a
+container widget for an empty-bodied container, in the course of decorating
+a proper \(non-container\) item which starts at the beginning of the file.
+
+Optional REDECORATE causes redecoration of the item-widget and
+its siblings, even if already decorated in this cycle of the command loop.
+
+Optional PARENT, when provided, bypasses some navigation and computation
+necessary to obtain the parent of the items being processed.
+
+We return the item-widget corresponding to the item at point."
+
+ (when (or redecorate
+ (not (equal (widget-get item-widget :last-decorated-tick)
+ allout-command-counter)))
+ (let* ((allout-inhibit-body-modification-hook t)
+ (was-modified (buffer-modified-p))
+ (was-point (point))
+ prefix-start
+ (is-container (or blank-container
+ (not (setq prefix-start (allout-goto-prefix)))
+ (< was-point prefix-start)))
+ ;; steady-point (set in two steps) is reliable across parent
+ ;; widget-creation.
+ (steady-point (progn (if is-container (goto-char 1))
+ (point-marker)))
+ (steady-point (progn (set-marker-insertion-type steady-point t)
+ steady-point))
+ (parent (and (not is-container)
+ (allout-get-or-create-parent-widget)))
+ parent-flags parent-depth
+ successor-sibling
+ body
+ doing-item
+ sub-item-widget
+ depth
+ reverse-siblings-chart
+ (buffer-undo-list t))
+
+ ;; At this point the parent is decorated and parent-flags indicate
+ ;; its guide lines. We will iterate over the siblings according to a
+ ;; chart we create at the start, and going from last to first so we
+ ;; don't have to worry about text displacement caused by widgetizing.
+
+ (if is-container
+ (progn (widget-put item-widget :is-container t)
+ (setq reverse-siblings-chart (list 1)))
+ (goto-char (widget-apply parent :actual-position :from))
+ (if (widget-get parent :is-container)
+ ;; `allout-goto-prefix' will go to first non-container item:
+ (allout-goto-prefix)
+ (allout-next-heading))
+ (setq depth (allout-recent-depth))
+ (setq reverse-siblings-chart (list allout-recent-prefix-beginning))
+ (while (allout-next-sibling)
+ (push allout-recent-prefix-beginning reverse-siblings-chart)))
+
+ (dolist (doing-at reverse-siblings-chart)
+ (goto-char doing-at)
+ (when allout-widgets-track-decoration
+ (sit-for 0))
+
+ (setq doing-item (if (= doing-at steady-point)
+ item-widget
+ (or (allout-get-item-widget)
+ (allout-new-item-widget))))
+
+ (when (or redecorate (not (equal (widget-get doing-item
+ :last-decorated-tick)
+ allout-command-counter)))
+ (widget-apply doing-item :parse-item t blank-container)
+ (widget-apply doing-item :decorate-item-span)
+
+ (widget-apply doing-item :decorate-guides
+ parent (and successor-sibling t))
+ (widget-apply doing-item :decorate-icon)
+ (widget-apply doing-item :decorate-cue)
+ (widget-apply doing-item :decorate-body)
+
+ (widget-put doing-item :last-decorated-tick allout-command-counter))
+
+ (setq successor-sibling doing-at))
+
+ (set-buffer-modified-p was-modified)
+ (goto-char steady-point)
+ ;; must null the marker or the buffer gets clogged with impedence:
+ (set-marker steady-point nil)
+
+ item-widget)))
+;;;_ > allout-redecorate-item (item)
+(defun allout-redecorate-item (item-widget)
+ "Resituate ITEM-WIDGET decorations, disregarding context.
+
+Use this to redecorate only the item, when you know that it's
+situation with respect to siblings, parent, and offspring is
+unchanged from its last decoration. Use
+`allout-decorate-item-and-context' instead to reassess and adjust
+relevent context, when suitable."
+ (if (not (equal (widget-get item-widget :last-decorated-tick)
+ allout-command-counter))
+ (let ((was-modified (buffer-modified-p))
+ (buffer-undo-list t))
+ (widget-apply item-widget :parse-item)
+ (widget-apply item-widget :decorate-guides)
+ (widget-apply item-widget :decorate-icon)
+ (widget-apply item-widget :decorate-cue)
+ (widget-apply item-widget :decorate-body)
+ (set-buffer-modified-p was-modified))))
+;;;_ > allout-redecorate-visible-subtree (&optional parent-widget
+;;; depth chart)
+(defun allout-redecorate-visible-subtree (&optional parent-widget depth chart)
+ "Redecorate all visible items in subtree at point.
+
+Optional PARENT-WIDGET is for optimization, when the parent
+widget is already available.
+
+Optional DEPTH restricts the excursion depth of covered.
+
+Optional CHART is for internal recursion, to carry a chart of the
+target items.
+
+Point is left at the last sibling in the visible subtree."
+ ;; using a treatment that takes care of all the siblings on a level, we
+ ;; only need apply it to the first sibling on the level, and we can
+ ;; collect and pass the parent of the lower levels to recursive calls as
+ ;; we go.
+ (let ((parent-widget
+ (if (and parent-widget (widget-apply parent-widget
+ :actual-position :from))
+ (progn (goto-char (widget-apply parent-widget
+ :actual-position :from))
+ parent-widget)
+ (let ((got (allout-get-item-widget)))
+ (if got
+ (allout-decorate-item-and-context got 'redecorate)
+ (allout-get-or-create-item-widget 'redecorate)))))
+ (pending-chart (or chart (allout-chart-subtree nil 'visible)))
+ item-widget
+ previous-sibling-point
+ previous-sibling
+ recent-sibling-point)
+ (setq pending-chart (nreverse pending-chart))
+ (dolist (sibling-point pending-chart)
+ (cond ((integerp sibling-point)
+ (when (not previous-sibling-point)
+ (goto-char sibling-point)
+ (if (setq item-widget (allout-get-item-widget nil))
+ (allout-decorate-item-and-context item-widget 'redecorate
+ nil parent-widget)
+ (allout-get-or-create-item-widget)))
+ (setq previous-sibling-point sibling-point
+ recent-sibling-point sibling-point))
+ ((listp sibling-point)
+ (if (or (not depth)
+ (> depth 1))
+ (allout-redecorate-visible-subtree
+ (if (not previous-sibling-point)
+ ;; containment discontinuity - sigh
+ parent-widget
+ (allout-get-or-create-item-widget 'redecorate))
+ (if depth (1- depth))
+ sibling-point)))))
+ (if (and recent-sibling-point (< (point) recent-sibling-point))
+ (goto-char recent-sibling-point))))
+;;;_ > allout-parse-item-at-point (item-widget &optional at-beginning
+;;; blank-container)
+(defun allout-parse-item-at-point (item-widget &optional at-beginning
+ blank-container)
+ "Set widget ITEM-WIDGET layout parameters per item-at-point's actual layout.
+
+If optional AT-BEGINNING is t, then point is assumed to be at the start of
+the item prefix.
+
+If optional BLANK-CONTAINER is true, then the parameters of a container
+which has an empty body are set. \(Though the body is blank, the object
+may have subitems.\)"
+
+ ;; Uncomment this sit-for to notice where decoration is happening:
+;; (sit-for .1)
+ (let* ((depth (allout-depth))
+ (depth (if blank-container 0 depth))
+ (is-container (or blank-container (zerop depth)))
+
+ (does-encrypt (and (not is-container)
+ (allout-encrypted-type-prefix)))
+ (is-encrypted (and does-encrypt (allout-encrypted-topic-p)))
+ (icon-end allout-recent-prefix-end)
+ (icon-start (1- icon-end))
+ body-start
+ body-end
+ bullet
+ has-subitems
+ (contents-depth (1+ depth))
+ )
+ (widget-put item-widget :depth depth)
+ (if is-container
+
+ (progn
+ (widget-put item-widget :from (allout-set-boundary-marker
+ :from (point-min)
+ (widget-get item-widget :from)))
+ (widget-put item-widget :icon-end nil)
+ (widget-put item-widget :icon-start nil)
+ (setq body-start (widget-put item-widget :body-start 1)))
+
+ ;; not container:
+
+ (widget-put item-widget :from (allout-set-boundary-marker
+ :from (if at-beginning
+ (point)
+ allout-recent-prefix-beginning)
+ (widget-get item-widget :from)))
+ (widget-put item-widget :icon-start icon-start)
+ (widget-put item-widget :icon-end icon-end)
+ (when does-encrypt
+ (widget-put item-widget :does-encrypt t)
+ (widget-put item-widget :is-encrypted is-encrypted))
+
+ ;; cue area:
+ (setq body-start icon-end)
+ (widget-put item-widget :bullet (setq bullet (allout-get-bullet)))
+ (if (equal (char-after body-start) ? )
+ (setq body-start (1+ body-start)))
+ (widget-put item-widget :body-start body-start)
+ )
+
+ ;; Both container and regular items:
+
+ ;; :body-end (doesn't include a trailing blank line, if any) -
+ (widget-put item-widget :body-end (setq body-end
+ (if blank-container
+ 1
+ (allout-end-of-entry))))
+
+ (widget-put item-widget :to (allout-set-boundary-marker
+ :to (if blank-container
+ (point-min)
+ (or (allout-pre-next-prefix)
+ (goto-char (point-max))))
+ (widget-get item-widget :to)))
+ (widget-put item-widget :has-subitems
+ (setq has-subitems
+ (and
+ ;; has a subsequent item:
+ (not (= body-end (point-max)))
+ ;; subsequent item is deeper:
+ (< depth (setq contents-depth (allout-recent-depth))))))
+ ;; note :expanded - true if widget item's content is currently visible?
+ (widget-put item-widget :expanded
+ (and has-subitems
+ ;; subsequent item is or isn't visible:
+ (save-excursion
+ (goto-char allout-recent-prefix-beginning)
+ (not (allout-hidden-p)))))))
+;;;_ > allout-set-boundary-marker (boundary position &optional
current-marker)
+(defun allout-set-boundary-marker (boundary position &optional current-marker)
+ "Set or create item widget BOUNDARY type marker at POSITION.
+
+Optional CURRENT-MARKER is the marker currently being used for
+the boundary, if any.
+
+BOUNDARY type is either :from or :to, determining the marker insertion type."
+ (if (not position) (setq position (point)))
+ (if current-marker
+ (set-marker current-marker position)
+ (let ((marker (make-marker)))
+ ;; XXX dang - would like for :from boundary to advance after inserted
+ ;; text, but that would omit new header prefixes when allout
+ ;; relevels, etc. this competes with ad-hoc edits, which would
+ ;; better be omitted
+ (set-marker-insertion-type marker nil)
+ (set-marker marker position))))
+;;;_ > allout-decorate-item-span (item-widget)
+(defun allout-decorate-item-span (item-widget)
+ "Equip the item with a span, as an entirety.
+
+This span is implemented so it can be used to detect displacement
+of the widget in absolute terms, and provides an offset bias for
+the various element spans."
+
+ (if (and (widget-get item-widget :is-container)
+ ;; the only case where the span could be empty.
+ (eq (widget-get item-widget :from)
+ (widget-get item-widget :to)))
+ nil
+ (allout-item-span item-widget
+ (widget-get item-widget :from)
+ (widget-get item-widget :to))))
+;;;_ > allout-decorate-item-guides (item-widget
+;;; &optional parent-widget has-successor)
+(defun allout-decorate-item-guides (item-widget
+ &optional parent-widget has-successor)
+ "Add ITEM-WIDGET guide icon-prefix descender and connector text properties.
+
+Optional arguments provide context for deriving the guides. In
+their absence, the current guide column flags are used.
+
+Optional PARENT-WIDGET is the widget for the item's parent item.
+
+Optional HAS-SUCCESSOR is true iff the item is followed by a sibling.
+
+We also hide the header-prefix string.
+
+Guides are established according to the item-widget's :guide-column-flags,
+when different than :was-guide-column-flags. Changing that property and
+reapplying this method will rectify the glyphs."
+
+ (when (not (widget-get item-widget :is-container))
+ (let* ((depth (widget-get item-widget :depth))
+ (parent-depth (and parent-widget
+ (widget-get parent-widget :depth)))
+ (parent-flags (and parent-widget
+ (widget-get parent-widget :guide-column-flags)))
+ (parent-flags-depth (length parent-flags))
+ (extender-length (- depth (+ parent-flags-depth 2)))
+ (flags (or (and (> depth 1)
+ parent-widget
+ (widget-put item-widget :guide-column-flags
+ (append (list has-successor)
+ (if (< 0 extender-length)
+ (make-list extender-length
+ '-))
+ parent-flags)))
+ (widget-get item-widget :guide-column-flags)))
+ (was-flags (widget-get item-widget :was-guide-column-flags))
+ (guides-start (widget-get item-widget :from))
+ (guides-end (widget-get item-widget :icon-start))
+ (position guides-start)
+ (increment (length allout-header-prefix))
+ reverse-flags
+ guide-name
+ extenders paint-extenders
+ (inhibit-read-only t))
+
+ (when (not (equal was-flags flags))
+
+ (setq reverse-flags (reverse flags))
+ (while reverse-flags
+ (setq guide-name
+ (cond ((null (cdr reverse-flags))
+ (if (car reverse-flags)
+ 'mid-connector
+ 'end-connector))
+ ((eq (car reverse-flags) '-)
+ ;; accumulate extenders tally, to be painted on next
+ ;; non-extender flag, according to the flag type.
+ (setq extenders (1+ (or extenders 0)))
+ nil)
+ ((car reverse-flags)
+ 'through-descender)
+ (t 'skip-descender)))
+ (when guide-name
+ (put-text-property position (setq position (+ position increment))
+ 'display (allout-fetch-icon-image guide-name))
+ (if (> increment 1) (setq increment 1))
+ (when extenders
+ ;; paint extenders after a connector, else leave spaces.
+ (dotimes (i extenders)
+ (put-text-property
+ position (setq position (1+ position))
+ 'display (allout-fetch-icon-image
+ (if (memq guide-name '(mid-connector end-connector))
+ 'extender-connector
+ 'skip-descender))))
+ (setq extenders nil)))
+ (setq reverse-flags (cdr reverse-flags)))
+ (widget-put item-widget :was-guide-column-flags flags))
+
+ (allout-item-element-span-is item-widget :guides-span
+ guides-start guides-end))))
+;;;_ > allout-decorate-item-icon (item-widget)
+(defun allout-decorate-item-icon (item-widget)
+ "Add item icon glyph and distinctive bullet text properties to ITEM-WIDGET."
+
+ (when (not (widget-get item-widget :is-container))
+ (let* ((icon-start (widget-get item-widget :icon-start))
+ (icon-end (widget-get item-widget :icon-end))
+ (bullet (widget-get item-widget :bullet))
+ (use-bullet bullet)
+ (was-bullet (widget-get item-widget :was-bullet))
+ (distinctive (allout-distinctive-bullet bullet))
+ (distinctive-start (widget-get item-widget :distinctive-start))
+ (distinctive-end (widget-get item-widget :distinctive-end))
+ (does-encrypt (widget-get item-widget :does-encrypt))
+ (is-encrypted (and does-encrypt (widget-get item-widget
+ :is-encrypted)))
+ (expanded (widget-get item-widget :expanded))
+ (has-subitems (widget-get item-widget :has-subitems))
+ (inhibit-read-only t)
+ icon-state)
+
+ (when (not (and (equal (widget-get item-widget :was-expanded) expanded)
+ (equal (widget-get item-widget :was-has-subitems)
+ has-subitems)
+ (equal (widget-get item-widget :was-does-encrypt)
+ does-encrypt)
+ (equal (widget-get item-widget :was-is-encrypted)
+ is-encrypted)))
+
+ (setq icon-state
+ (cond (does-encrypt (if is-encrypted
+ 'encrypted-locked
+ 'encrypted-unlocked))
+ (expanded 'opened)
+ (has-subitems 'closed)
+ (t 'empty)))
+ (put-text-property icon-start (1+ icon-start)
+ 'display (allout-fetch-icon-image icon-state))
+ (widget-put item-widget :was-expanded expanded)
+ (widget-put item-widget :was-has-subitems has-subitems)
+ (widget-put item-widget :was-does-encrypt does-encrypt)
+ (widget-put item-widget :was-is-encrypted is-encrypted)
+ ;; preserve as a widget property to track last known:
+ (widget-put item-widget :icon-state icon-state)
+ ;; preserve as a text property to track undo:
+ (put-text-property icon-start icon-end :icon-state icon-state))
+ (allout-item-element-span-is item-widget :icon-span
+ icon-start icon-end)
+ (when (not (string= was-bullet bullet))
+ (cond ((not distinctive)
+ ;; XXX we strip the prior properties without even checking if
+ ;; the prior bullet was distinctive, because the widget
+ ;; provisions to convey that info is disappearing, sigh.
+ (remove-text-properties icon-end (1+ icon-end) '(display))
+ (setq distinctive-start icon-end distinctive-end icon-end)
+ (widget-put item-widget :distinctive-start distinctive-start)
+ (widget-put item-widget :distinctive-end distinctive-end))
+
+ ((not (string= bullet allout-numbered-bullet))
+ (setq distinctive-start icon-end distinctive-end (+ icon-end
1)))
+
+ (does-encrypt
+ (setq distinctive-start icon-end distinctive-end (+ icon-end
1)))
+
+ (t
+ (goto-char icon-end)
+ (looking-at "[0-9]+")
+ (setq use-bullet (buffer-substring icon-end (match-end 0)))
+ (setq distinctive-start icon-end
+ distinctive-end (match-end 0))))
+ (put-text-property distinctive-start distinctive-end 'display
+ use-bullet)
+ (widget-put item-widget :was-bullet bullet)
+ (widget-put item-widget :distinctive-start distinctive-start)
+ (widget-put item-widget :distinctive-end distinctive-end)))))
+;;;_ > allout-decorate-item-cue (item-widget)
+(defun allout-decorate-item-cue (item-widget)
+ "Incorporate space between bullet icon and body to the ITEM-WIDGET."
+ ;; NOTE: most of the cue-area
+
+ (when (not (widget-get item-widget :is-container))
+ (let* ((cue-start (or (widget-get item-widget :distinctive-end)
+ (widget-get item-widget :icon-end)))
+ (body-start (widget-get item-widget :body-start))
+ (expanded (widget-get item-widget :expanded))
+ (has-subitems (widget-get item-widget :has-subitems))
+ (inhibit-read-only t))
+
+ (allout-item-element-span-is item-widget :cue-span cue-start body-start)
+ (put-text-property (1- body-start) body-start 'rear-nonsticky t))))
+;;;_ > allout-decorate-item-body (item-widget &optional force)
+(defun allout-decorate-item-body (item-widget &optional force)
+ "Incorporate item body text as part the ITEM-WIDGET.
+
+Optional FORCE means force reassignment of the region property."
+
+ (let* ((allout-inhibit-body-modification-hook t)
+ (body-start (widget-get item-widget :body-start))
+ (body-end (widget-get item-widget :body-end))
+ (body-text-end body-end)
+ (inhibit-read-only t))
+
+ (allout-item-element-span-is item-widget :body-span
+ body-start (min (1+ body-end) (point-max))
+ force)))
+;;;_ > allout-item-actual-position (item-widget field)
+(defun allout-item-actual-position (item-widget field)
+ "Return ITEM-WIDGET FIELD position taking item displacement into account."
+
+ ;; The item's sub-element positions (:icon-end, :body-start, etc) are
+ ;; accurate when the item is parsed, but some offsets from the start
+ ;; drift with text added in the body.
+ ;;
+ ;; Rather than reparse an item with every change (inefficient), or derive
+ ;; every position from a distinct field marker/overlay (prohibitive as
+ ;; the number of items grows), we use the displacement tracking of the
+ ;; :span-overlay's markers, against the registered :from or :body-end
+ ;; (depending on whether the requested field value is before or after the
+ ;; item body), to bias the registered values.
+ ;;
+ ;; This is not necessary/useful when the item is being decorated, because
+ ;; that always must be preceeded by a fresh item parse.
+
+ (if (not (eq field :body-end))
+ (widget-get item-widget :from)
+
+ (let* ((span-overlay (widget-get item-widget :span-overlay))
+ (body-end-position (widget-get item-widget :body-end))
+ (ref-marker-position (and span-overlay
+ (overlay-end span-overlay)))
+ (offset (and body-end-position span-overlay
+ (- (or ref-marker-position 0)
+ body-end-position))))
+ (+ (widget-get item-widget field) (or offset 0)))))
+;;;_ : Item undecoration
+;;;_ > allout-widgets-undecorate-region (start end)
+(defun allout-widgets-undecorate-region (start end)
+ "Eliminate widgets and decorations for all items in region from START to
END."
+ (let ((next start)
+ widget)
+ (save-excursion
+ (goto-char start)
+ (while (< (setq next (next-single-char-property-change next
+ 'display
+ (current-buffer)
+ end))
+ end)
+ (goto-char next)
+ (when (setq widget (allout-get-item-widget))
+ ;; if the next-property/overly progression got us to a widget:
+ (allout-widgets-undecorate-item widget t))))))
+;;;_ > allout-widgets-undecorate-text (text)
+(defun allout-widgets-undecorate-text (text)
+ "Eliminate widgets and decorations for all items in TEXT."
+ (remove-text-properties 0 (length text)
+ '(display nil :icon-state nil rear-nonsticky nil
+ category nil button nil field nil)
+ text)
+ text)
+;;;_ > allout-widgets-undecorate-item (item-widget &optional no-expose)
+(defun allout-widgets-undecorate-item (item-widget &optional no-expose)
+ "Remove widget decorations from ITEM-WIDGET.
+
+Any concealed content head lines and item body is exposed, unless
+optional NO-EXPOSE is non-nil."
+ (let ((from (widget-get item-widget :from))
+ (to (widget-get item-widget :to))
+ (text-properties-to-remove '(display nil
+ :icon-state nil
+ rear-nonsticky nil
+ category nil
+ button nil
+ field nil))
+ (span-overlay (widget-get item-widget :span-overlay))
+ (button-overlay (widget-get item-widget :button))
+ (was-modified (buffer-modified-p))
+ (buffer-undo-list t)
+ (inhibit-read-only t))
+ (if (not no-expose)
+ (allout-flag-region from to nil))
+ (allout-unprotected
+ (remove-text-properties from to text-properties-to-remove))
+ (when span-overlay
+ (delete-overlay span-overlay) (widget-put item-widget :span-overlay nil))
+ (when button-overlay
+ (delete-overlay button-overlay) (widget-put item-widget :button nil))
+ (set-marker from nil)
+ (set-marker to nil)
+ (if (not was-modified)
+ (set-buffer-modified-p nil))))
+
+;;;_ : Item decoration support
+;;;_ > allout-item-span (item-widget &optional start end)
+(defun allout-item-span (item-widget &optional start end)
+ "Return or register the location of an ITEM-WIDGET's actual START and END.
+
+If START and END are not passed in, return either a dotted pair
+of the current span, if established, or nil if not yet set.
+
+When the START and END are passed, return the distance that the
+start of the item moved. We return 0 if the span was not
+previously established or is not moved."
+ (let ((overlay (widget-get item-widget :span-overlay))
+ was-start was-end
+ changed)
+ (cond ((not overlay) (when start
+ (setq overlay (make-overlay start end nil t nil))
+ (overlay-put overlay 'button item-widget)
+ (widget-put item-widget :span-overlay overlay)
+ t))
+ ;; report:
+ ((not start) (cons (overlay-start overlay) (overlay-end overlay)))
+ ;; move:
+ ((or (not (equal (overlay-start overlay) start))
+ (not (equal (overlay-end overlay) end)))
+ (move-overlay overlay start end)
+ t)
+ ;; specified span already set:
+ (t nil))))
+;;;_ > allout-item-element-span-is (item-widget element
+;;; &optional start end force)
+(defun allout-item-element-span-is (item-widget element
+ &optional start end force)
+ "Return or register the location of the indicated ITEM-WIDGET ELEMENT.
+
+ELEMENT is one of :guides-span, :icon-span, :cue-span, or :body-span.
+
+When optional START is specified, optional END must also be.
+
+START and END are the actual bounds of the region, if provided.
+
+If START and END are not passed in, we return either a dotted
+pair of the current span, if established, or nil if not yet set.
+
+When the START and END are passed, we return t if the region
+changed or nil if not.
+
+Optional FORCE means force assignment of the region's text
+property, even if it's already set."
+ (let ((span (widget-get item-widget element)))
+ (cond ((or (not span) force)
+ (when start
+ (widget-put item-widget element (cons start end))
+ (put-text-property start end 'category
+ (cdr (assoc element
+ allout-span-to-category)))
+ t))
+ ;; report:
+ ((not start) span)
+ ;; move if necessary:
+ ((not (and (eq (car span) start)
+ (eq (cdr span) end)))
+ (widget-put item-widget element span)
+ t)
+ ;; specified span already set:
+ (t nil))))
+;;;_ : Item widget retrieval (/ high-level creation):
+;;;_ > allout-get-item-widget (&optional container)
+(defun allout-get-item-widget (&optional container)
+ "Return the widget for the item at point, or nil if no widget yet exists.
+
+Point must be situated *before* the start of the target item's
+body, so we don't get an existing containing item when we're in
+the process of creating an item in the middle of another.
+
+Optional CONTAINER is used to obtain the container item."
+ (if (or container (zerop (allout-depth)))
+ allout-container-item-widget
+ ;; allout-recent-* are calibrated by (allout-depth) if we got here.
+ (let ((got (widget-at allout-recent-prefix-beginning)))
+ (if (and got (listp got))
+ (if (marker-position (widget-get got :from))
+ (and
+ (>= (point) (widget-apply got :actual-position :from))
+ (<= (point) (widget-apply got :actual-position :body-start))
+ got)
+ ;; a wacky residual item - undecorate and disregard:
+ (allout-widgets-undecorate-item got)
+ nil)))))
+;;;_ > allout-get-or-create-item-widget (&optional redecorate
blank-container)
+(defun allout-get-or-create-item-widget (&optional redecorate blank-container)
+ "Return a widget for the item at point, creating the widget if necessary.
+
+When creating a widget, we assume there has been a context change
+and decorate its siblings and parent, as well.
+
+Optional BLANK-CONTAINER is for internal use, to fabricate a
+meta-container item with an empty body when the first proper
+\(non-container\) item starts at the beginning of the file.
+
+Optional REDECORATE, if non-nil, means to redecorate the widget
+if it already exists."
+ (let ((widget (allout-get-item-widget blank-container))
+ (buffer-undo-list t))
+ (cond (widget (if redecorate
+ (allout-redecorate-item widget))
+ widget)
+ ((or blank-container (zerop (allout-depth)))
+ (or allout-container-item-widget
+ (setq allout-container-item-widget
+ (allout-decorate-item-and-context
+ (widget-convert 'allout-item-widget)
+ nil blank-container))))
+ ;; create a widget for a regular/non-container item:
+ (t (allout-decorate-item-and-context (widget-convert
+ 'allout-item-widget))))))
+;;;_ > allout-get-or-create-parent-widget (&optional redecorate)
+(defun allout-get-or-create-parent-widget (&optional redecorate)
+ "Return widget for parent of item at point, decorating it if necessary.
+
+We return the container widget if we're above the first proper item in the
+file.
+
+Optional REDECORATE, if non-nil, means to redecorate the widget if it
+already exists.
+
+Point will wind up positioned on the beginning of the parent or beginning
+of the buffer."
+ ;; use existing widget, if there, else establish it
+ (if (or (bobp) (and (not (allout-ascend))
+ (looking-at allout-regexp)))
+ (allout-get-or-create-item-widget redecorate 'blank-container)
+ (allout-get-or-create-item-widget redecorate)))
+;;;_ : X- Item ancillaries
+;;;_ >X allout-body-modification-handler (beg end)
+(defun allout-body-modification-handler (beg end)
+ "Do routine processing of body text before and after modification.
+
+Operation is inhibited by `allout-inhibit-body-modification-handler'."
+
+;; The primary duties are:
+;;
+;; - marking of escaped prefix-like text for delayed cleanup of escapes
+;; - removal and replacement of the settings
+;; - maintenance of beginning-of-line guide lines
+;;
+;; ?? Escapes removal \(before changes\) is not done when edits span multiple
+;; items, recognizing that item structure is being preserved, including
+;; escaping of item-prefix-like text within bodies. See
+;; `allout-before-modification-handler' and
+;; `allout-inhibit-body-modification-handler'.
+;;
+;; Adds the overlay to the `allout-unresolved-body-mod-workhash' during
+;; before-change operation, and removes from that list during after-change
+;; operation.
+ (cond (allout-inhibit-body-modification-hook nil)))
+;;;_ >X allout-graphics-modification-handler (beg end)
+(defun allout-graphics-modification-handler (beg end)
+ "Protect against incoherent deletion of decoration graphics.
+
+Deletes allowed only when inhibit-read-only is t."
+ (cond
+ (undo-in-progress (when (eq (get-text-property beg 'category)
+ 'allout-icon-span-category)
+ (save-excursion
+ (goto-char beg)
+ (let* ((item-widget (allout-get-item-widget)))
+ (if item-widget
+ (allout-widgets-exposure-undo-recorder
+ item-widget))))))
+ (inhibit-read-only t)
+ ((not (and (boundp 'allout-mode) allout-mode)) t)
+ ((equal this-command 'quoted-insert) t)
+ ((yes-or-no-p "Unruly edit of outline structure - allow? ")
+ (setq allout-widgets-unset-inhibit-read-only (not inhibit-read-only)
+ inhibit-read-only t))
+ (t (error
+ (substitute-command-keys allout-structure-unruly-deletion-message)))))
+;;;_ > allout-item-icon-key-handler ()
+(defun allout-item-icon-key-handler ()
+ "Catchall handling of key bindings in item icon/cue hot-spots.
+
+Applies `allout-hotspot-key-handler' and calls the result, if any, as an
+interactive command."
+
+ (interactive)
+ (let* ((mapped-binding (allout-hotspot-key-handler)))
+ (when mapped-binding
+ (call-interactively mapped-binding))))
+
+;;;_ : Status
+;;;_ . allout-item-location (item-widget)
+(defun allout-item-location (item-widget)
+ "Location of the start of the item's text."
+ (overlay-start (widget-get item-widget :span-overlay)))
+
+;;;_ : Icon management
+;;;_ > allout-fetch-icon-image (name)
+(defun allout-fetch-icon-image (name)
+ "Fetch allout icon for symbol NAME.
+
+We use a caching strategy, so the caller doesn't need to do so."
+ (let* ((types allout-widgets-icon-types)
+ (use-dir (if (equal (allout-frame-property nil 'background-mode)
+ 'light)
+ allout-widgets-icons-light-subdir
+ allout-widgets-icons-dark-subdir))
+ (key (list name use-dir))
+ (got (assoc key allout-widgets-icons-cache)))
+ (if got
+ ;; display system shows only first of subsequent adjacent
+ ;; `eq'-identical repeats - use copies to avoid this problem.
+ (allout-widgets-copy-list (cadr got))
+ (while (and types (not got))
+ (setq got
+ (allout-find-image
+ (list (append (list :type (car types)
+ :file (concat use-dir
+ (symbol-name name)
+ "." (symbol-name
+ (car types))))
+ (if (featurep 'xemacs)
+ allout-widgets-item-image-properties-xemacs
+ allout-widgets-item-image-properties-emacs)
+ ))))
+ (setq types (cdr types)))
+ (if got
+ (push (list key got) allout-widgets-icons-cache))
+ got)))
+
+;;;_ : Miscellaneous
+;;;_ > allout-elapsed-time-seconds (triple)
+(defun allout-elapsed-time-seconds (end start)
+ "Return seconds between `current-time' style time START/END triples."
+ (let ((elapsed (time-subtract end start)))
+ (+ (* (car elapsed) (expt 2.0 16))
+ (cadr elapsed)
+ (/ (caddr elapsed) (expt 10.0 6)))))
+;;;_ > allout-frame-property (frame property)
+(defalias 'allout-frame-property
+ (cond ((fboundp 'frame-parameter)
+ 'frame-parameter)
+ ((fboundp 'frame-property)
+ 'frame-property)
+ (t nil)))
+;;;_ > allout-find-image (specs)
+(defalias 'allout-find-image
+ (if (fboundp 'find-image)
+ 'find-image
+ nil) ; aka, not-yet-implemented for xemacs.
+)
+;;;_ > allout-widgets-copy-list (list)
+(defun allout-widgets-copy-list (list)
+ ;; duplicated from cl.el 'copy-list' as of 2008-08-17
+ "Return a copy of LIST, which may be a dotted list.
+The elements of LIST are not copied, just the list structure itself."
+ (if (consp list)
+ (let ((res nil))
+ (while (consp list) (push (pop list) res))
+ (prog1 (nreverse res) (setcdr res list)))
+ (car list)))
+
+;;;_ : Run unit tests:
+(defun allout-widgets-run-unit-tests ()
+ (message "Running allout-widget tests...")
+
+ (allout-test-range-overlaps)
+
+ (message "Running allout-widget tests... Done.")
+ (sit-for .5))
+
+(when allout-widgets-run-unit-tests-on-load
+ (allout-widgets-run-unit-tests))
+
+;;;_ : provide
+(provide 'allout-widgets)
+
+;;;_. Local emacs vars.
+;;;_ , Local variables:
+;;;_ , allout-layout: (-1 : 0)
+;;;_ , End:
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r103305: * lisp/allout-widgets.el: New allout extension that shows allout outline,
Ken Manheimer <=