-
Notifications
You must be signed in to change notification settings - Fork 0
/
annalist-20190929.207.tar
1428 lines (1232 loc) · 70 KB
/
annalist-20190929.207.tar
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
annalist-20190929.207/ 0000775 0001750 0001750 00000000000 14133447050 012604 5 ustar kimr kimr annalist-20190929.207/dir 0000664 0001750 0001750 00000001233 14133447050 013304 0 ustar kimr kimr This is the file .../info/dir, which contains the
topmost node of the Info hierarchy, called (dir)Top.
The first time you invoke Info you start off looking at this node.
File: dir, Node: Top This is the top of the INFO tree
This (the Directory node) gives a menu of major topics.
Typing "q" exits, "H" lists all Info commands, "d" returns here,
"h" gives a primer for first-timers,
"mEmacs<Return>" visits the Emacs manual, etc.
In Emacs, you can click mouse button 2 on a menu item or cross reference
to select it.
* Menu:
Emacs
* Annalist: (annalist). Record and display information such as
keybindings.
annalist-20190929.207/annalist.el 0000664 0001750 0001750 00000107106 14133447050 014744 0 ustar kimr kimr ;;; annalist.el --- Record and display information such as keybindings -*- lexical-binding: t; -*-
;; Author: Fox Kiester <[email protected]>
;; URL: https://github.com/noctuid/annalist.el
;; Keywords: convenience, tools, keybindings, org
;; Package-Requires: ((emacs "24.4") (cl-lib "0.5"))
;; Version: 1.0
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This library supports recording information (such as keybindings) and later
;; displaying that information in Org tables.
;; For more information see the repository README.
;;; Code:
(require 'cl-lib)
;; must be loaded at compile time so `org-babel-map-src-blocks' can be expanded
;; but not necessary when loading/evaling until/unless
;; `annalist-multiline-source-blocks' is called
(cl-eval-when (compile)
(require 'ob-core))
(defgroup annalist nil
"Record and display information such as keybindings."
:group 'convenience
:prefix "annalist-")
(defcustom annalist-record t
"Whether function `annalist-record' should do anything.
Set this to nil if you never use `annalist-describe' and want to shave some
milliseconds off of your init time."
:type 'boolean)
(define-widget 'annalist-list 'lazy
"List with elements in the form (<annalist-name> <tome-type>).
Type for `annalist-record-blacklist' and `annalist-record-whitelist'."
:type '(choice (list (list symbol symbol))
(const nil)))
(defcustom annalist-record-whitelist nil
"Whitelist of annalist-name/tome-type pairs to allow recording.
An example value would be (list (list 'annalist 'keybindings)). t can be
specified to match all annalist names or tome types. Setting this variable is
mutually exclusive with setting `annalist-record-blacklist'. Setting this
variable will have no effect if variable `annalist-record' is nil."
:type 'annalist-list)
(defcustom annalist-record-blacklist nil
"Blacklist of annalist-name/tome-type pairs to ignore.
An example value would be (list (list 'annalist 'keybindings)). t can be
specified to match all annalist names or tome types. Setting this variable is
mutually exclusive with setting `annalist-record-whitelist'. Setting this
variable will have no effect if variable `annalist-record' is nil."
:type 'annalist-list)
(defcustom annalist-describe-hook nil
"Hook run in the description buffer after it has been populated.
The buffer is editable when this hook is run."
:type 'hook)
(defcustom annalist-org-startup-folded nil
"The setting of `org-startup-folded' to use in `annalist-describe'."
:type '(choice
(const :tag "nofold: show all" nil)
(const :tag "fold: overview" t)
(const :tag "content: all headlines" content)
(const :tag "show everything, even drawers" showeverything)))
(declare-function lispy-alt-multiline "lispy")
(defcustom annalist-multiline-function #'lispy-alt-multiline
"Used in `annalist-multiline-source-blocks' to format top level forms.
The default is `lispy-alt-multiline' which results in shorter line lengths.
`lispy-multiline' is another alternative."
:type 'function)
;; * Storage Variables
(defvar annalist--tomes nil
"Stores recorded information for defined tomes.")
(defvar-local annalist--local-tomes nil
"Stores buffer-local recorded information for defined tomes.")
(defvar annalist--tomes-settings nil
"Stores settings for defined tomes.")
(defvar annalist--tomes-views (make-hash-table :test #'equal)
"Stores possible views for defined tomes.")
;; * List Helpers
(defun annalist--make-list (item)
"If ITEM is a list, return it; otherwise return (list ITEM).
If ITEM is a lambda, it will not be considered to be a list."
(if (and (listp item)
(not (functionp item)))
item
(list item)))
(defun annalist--merge-lists (a b &optional test)
"Return the result of merging the lists A in B.
Merging is done by adding items in B that are not in A (as tested by TEST) to
the end of A. The order of both lists is preserved."
(append a
(cl-loop for b-item in b
when (not (if test
(cl-some (lambda (a-item)
(funcall test a-item b-item))
a)
(member b-item a)))
collect b-item)))
(defun annalist--merge-plists (a b)
"Return the result of merging the plists A and B.
When the same property exists in both A and B, prefer A's value."
(let ((res (cl-copy-list a)))
(cl-loop for (prop val) on b by #'cddr
unless (plist-get res prop)
do (setq res (plist-put res prop val)))
res))
(defun annalist--merge-nested-plists (a b)
"Return the result of merging the settings plists A and B.
When the same property exists in both A and B, prefer A's value unless the value
is a nested plist. In that case, merge the nested plists of the two. This
function only handles one level of nesting."
(let ((res (cl-copy-list a)))
(cl-loop for (prop val) on b by #'cddr
if (not (plist-get res prop))
do (setf (cl-getf res prop) val)
else
if (listp val)
do (setf (cl-getf res prop)
(annalist--merge-plists (plist-get res prop)
val)))
res))
(defun annalist--get (plist fallback-plist keyword &optional default)
"From PLIST or FALLBACK-PLIST get the corresponding value for KEYWORD.
FALLBACK-PLIST will be checked when KEYWORD does not exist in PLIST (but not in
cases where it is explicitly specified in PLIST as nil). If KEYWORD is not
specified in either plist, return DEFAULT."
(cl-getf plist keyword
(cl-getf fallback-plist keyword default)))
(defun annalist--item-get (settings item prop &optional default)
"Extract an item-specific setting from SETTINGS.
SETTINGS is a settings plist of the form (ITEM1 (PROP1 value1) :defaults (PROP1
defaultvalue)). ITEM is the item to check for PROP for. PROP is the setting to
check for (e.g. :format). If PROP does not appear in the ITEM's plist, return
the value from the :defaults plist (or DEFAULT if the property is not specified
in either)."
(let ((default-item-settings (plist-get settings :defaults))
(item-settings (plist-get settings item)))
(annalist--get item-settings default-item-settings prop default)))
(defun annalist--test (settings item)
"Return the test specified by :test in SETTINGS for ITEM's plist.
SETTINGS is a plist in the form (ITEM1 (:test 'eq) ITEM2 (:test 'my-test)
:defaults (:test 'some-test)). If :test is not in ITEM's plist, check for :test
in the :defaults plist. If :test is in neither plist, return #'equal."
(or (annalist--item-get settings item :test)
#'equal))
(defun annalist--plistify-settings (definition-settings type &optional view)
"Convert DEFINITION-SETTINGS to an internally useable plist.
DEFINITION-SETTINGS is a list of arguments for `annalist-define-tome'.
For example:
'(:test my-equal
:primary-key (keymap key)
keymap
key
definition)
would become (ignoring order):
'(:type TYPE
:test my-equal
:primary-key (keymap key)
:key-indices (0 1)
:final-index 2
:metadata-index 3
0 (:name keymap :index 0)
1 (:name key :index 1)
2 (:name definition :index 2)
keymap (:name keymap :index 0)
key (:name key :index 1)
definition (:name definition index 2))
If VIEW is non-nil, exclude the extra generated information (e.g. :final-index).
Also allow not specifying all items. Indices are determined by checking the
stored settings for TYPE."
(let ((counter 0)
(tome-settings (when view
(annalist--get-tome-settings type)))
primary-key
key-indices
plist)
(cl-loop for (key val) on definition-settings by #'cddr
if (eq key :primary-key)
do (setq primary-key (if (listp val)
val
(list val))))
(while definition-settings
(let ((entry (pop definition-settings)))
(if (keywordp entry)
(setq plist (plist-put plist entry (pop definition-settings)))
(let* ((item (if (listp entry)
(car entry)
entry))
(index (if view
(plist-get (plist-get tome-settings item)
:index)
counter))
(item-definition-settings (append (list :name item
:index index)
(and (listp entry)
(cdr entry)))))
(setq plist (plist-put plist item item-definition-settings))
(setq plist (plist-put plist index item-definition-settings))
(when (memq item primary-key)
(push counter key-indices))
(cl-incf counter)))))
(if view
plist
(append (list :type type
:key-indices (sort key-indices #'<)
:final-index (1- counter)
:metadata-index counter)
plist))))
(defun annalist-plistify-record (record type)
"Convert the ordered RECORD list of TYPE to a plist."
(let* ((settings (annalist--get-tome-settings type))
(metadata (nth (plist-get settings :metadata-index) record)))
(cl-loop for i from 0 to (plist-get settings :final-index)
collect (plist-get (plist-get settings i) :name) into plist
and collect (nth i record) into plist
finally (cl-return (nconc plist (list t metadata))))))
(defun annalist-listify-record (record type)
"Convert the RECORD plist of TYPE to an ordered list."
(let* ((settings (annalist--get-tome-settings type)))
(cl-loop for i from 0 to (plist-get settings :final-index)
collect (plist-get record (plist-get (plist-get settings i) :name))
into list
finally (cl-return (nconc list (list (plist-get record t)))))))
(defun annalist--tome (type &optional local)
"Return the tome for TYPE and LOCAL, creating it if necessary."
(let ((tome (if local
(plist-get annalist--local-tomes type)
(plist-get annalist--tomes type))))
(or tome
(progn
(if local
(setq annalist--local-tomes
(plist-put annalist--local-tomes type
(make-hash-table :test #'equal)))
(setq annalist--tomes
(plist-put annalist--tomes type
(make-hash-table :test #'equal))))
(annalist--tome type local)))))
;; * Hash Table Helpers
(defsubst annalist--hash-table-keys (hash-table)
"Return a list of keys in HASH-TABLE.
The default `hash-table-keys' makes no guarantee about the order of the keys,
and the behavior differs between Emacs versions. This function returns the keys
in the order of usage (least recent to most recent) at least for Emacs 24.4 up
to Emacs 27."
(cl-loop for k being the hash-keys of hash-table collect k))
(defsubst annalist--hash-table-values (hash-table)
"Return a list of the values in HASH-TABLE.
See `annalist--hash-table-keys' for more information."
(cl-loop for v being the hash-values of hash-table collect v))
;; * Type Definition
(defun annalist--get-tome-settings (type)
"Return the settings plist for TYPE."
(plist-get annalist--tomes-settings type))
(defun annalist-define-tome (type settings)
"Create a new type of thing that can be recorded called TYPE.
SETTINGS be a list of items and any settings necessary for recording them."
(declare (indent 1))
(setq annalist--tomes-settings
(plist-put annalist--tomes-settings type
(annalist--plistify-settings settings type))))
;; * View Definition
(defun annalist--get-view-settings (type view)
"Return the settings plist corresponding to TYPE and VIEW."
(unless view
(setq view 'default))
(gethash (cons type view) annalist--tomes-views))
(gv-define-setter annalist--get-view-settings (val type view)
`(puthash (cons ,type (or ,view 'default)) ,val annalist--tomes-views))
(cl-defun annalist-define-view (type name settings &key inherit)
"Define a display method for TYPE called NAME.
To define the default view SETTINGS, NAME should be 'default. If INHERIT is
non-nil, inherit SETTINGS from that view."
(declare (indent 2))
;; exclude extra settings because may not have specified every item and don't
;; want to change :final-index
(setq settings (annalist--plistify-settings settings type t))
(when inherit
(setq settings (annalist--merge-nested-plists
settings
(annalist--get-view-settings type inherit))))
(setf (annalist--get-view-settings type name) settings))
;; * Recording
(defun annalist--record-record (new-record existing-records settings)
"Non-destructively add NEW-RECORD to EXISTING-RECORDS and return it.
SETTINGS is the plist of settings for the type of thing/tome the record
corresponds to (e.g. keybindings).
When the primary key in NEW-RECORD matches that in an old record exactly (as
determined by :test in SETTINGS or `equal'), replace the old record with
NEW-RECORD.
When :record-update is present in SETTINGS, use its value to update the
NEW-RECORD (e.g. to update a \"previous definition\" item). An update function
is passed the old record (nil if none), NEW-RECORD, and SETTINGS. It should
return an updated recording to store."
(unless existing-records
(setq existing-records (make-hash-table :test (or (plist-get settings :test)
#'equal))))
(let* ((key-indices (plist-get settings :key-indices))
(primary-key (cl-loop for index in key-indices
collect (nth index new-record)))
(update (plist-get settings :record-update))
(old-record (gethash primary-key existing-records)))
(when update
(setq new-record (funcall update old-record new-record settings)))
(puthash primary-key new-record existing-records)
existing-records))
(defun annalist--record-headings (record store depth settings)
"Non-destructively record RECORD into STORE, returning STORE.
RECORD is a list of the headings and column entries for a row to be recorded.
DEPTH is the depth of the current item being recorded. SETTINGS is the plist of
settings for the type of thing/tome being recorded (e.g. keybindings). If DEPTH
exceeds the max heading depth in SETTINGS (i.e. it is the depth at which the
table starts as specified by :table-start-index), insert RECORD into the current
STORE and return it. Otherwise, record the current item as a heading in STORE
and recurse with an incremented DEPTH."
(if (>= depth
(plist-get settings :table-start-index))
(annalist--record-record record store settings)
(let* ((test (annalist--test settings depth))
(store (if (hash-table-p store)
store
(make-hash-table :test test)))
(next-store (gethash (nth depth record) store)))
(puthash (nth depth record)
(annalist--record-headings record next-store (1+ depth) settings)
store)
store)))
(defun annalist--matches-white-or-black-list-p (list annalist type)
"Return whether LIST has an entry matching ANNALIST and TYPE."
(cl-some (lambda (entry)
(cl-destructuring-bind (entry-annalist entry-type) entry
(and (or (eq entry-annalist t)
(equal entry-annalist annalist))
(or (eq entry-type t)
(equal entry-type type)))))
list))
(defun annalist--should-record-p (annalist type)
"Return whether recording for ANNALIST and TYPE is enabled.
Consult variable `annalist-record', `annalist-record-whitelist', and
`annalist-record-blacklist'."
(and annalist-record
(cond (annalist-record-whitelist
(annalist--matches-white-or-black-list-p
annalist-record-whitelist annalist type))
(annalist-record-blacklist
(not (annalist--matches-white-or-black-list-p
annalist-record-blacklist annalist type)))
(t t))))
;;;###autoload
(cl-defun annalist-record (annalist type record &key local plist)
"In the store for ANNALIST, TYPE, and LOCAL, record RECORD.
ANNALIST should correspond to the package/user recording this information (e.g.
'general, 'me, etc.). TYPE is the type of information being recorded (e.g.
'keybindings). LOCAL corresponds to whether to store RECORD only for the current
buffer. This information together is used to select where RECORD should be
stored in and later retrieved from with `annalist-describe'. RECORD should be a
list of items to record and later print as org headings and column entries in a
single row. If PLIST is non-nil, RECORD should be a plist instead of an ordered
list (e.g. '(keymap org-mode-map key \"C-c a\" ...)). The plist keys should be
the symbols used for the definition of TYPE."
(when (annalist--should-record-p annalist type)
(let* ((tome (annalist--tome type local))
(settings (annalist--get-tome-settings type))
(preprocess (plist-get settings :preprocess))
(store (gethash annalist tome))
(num-unspecified-items (- (plist-get settings :metadata-index)
(1- (length record)))))
(when plist
(setq record (annalist-listify-record record type)))
(when preprocess
(setq record (funcall preprocess record settings)))
(unless (<= num-unspecified-items 0)
(setq record (nconc record (make-list num-unspecified-items nil))))
(puthash annalist
(annalist--record-headings record store 0 settings)
tome))))
;; * Printing
(defun annalist--safe-pipe (item)
"Format ITEM to replace all \"|\" occurrences with \"¦\"."
(replace-regexp-in-string "|" "¦" item))
(defvar annalist--fn-counter nil
"Counter for the current footnote.")
(defun annalist--print-table-header (settings)
"Print an org table header using the titles from SETTINGS."
(let ((i (plist-get settings :table-start-index))
item-settings
title)
(while (setq item-settings (plist-get settings i))
(setq title (or (plist-get item-settings :title)
(capitalize (symbol-name
(plist-get item-settings :name)))))
(princ "|")
(princ (annalist--safe-pipe (format "%s" title)))
(cl-incf i)))
(princ "|\n|-+-|\n"))
;; TODO split this up
(defun annalist--print-table (records settings)
"Print an org table for RECORDS using SETTINGS."
;; printed oldest to newest
;; TODO could add option to do newest to oldest instead
(setq records (annalist--hash-table-values records))
(let* ((predicate (plist-get settings :predicate))
(sorter (plist-get settings :sort))
(sorted-records (if sorter
(sort records sorter)
records))
(start-index (plist-get settings :table-start-index))
(postprocess (plist-get settings :postprocess))
footnotes)
;; print header
(annalist--print-table-header settings)
;; print rows
(dolist (record sorted-records)
(when (or (null predicate)
(funcall predicate record))
(when postprocess
(setq record (funcall postprocess record settings)))
(cl-loop
for i from start-index to (plist-get settings :final-index)
do
(let* ((item (nth i record))
(formatter (annalist--item-get settings i :format))
(max-width (annalist--item-get settings i :max-width 50))
(extractp (annalist--item-get settings i :extractp))
(src-block-p (annalist--item-get settings i :src-block-p))
(too-long (and max-width
(> (length (format "%s" item))
max-width))))
;; space ensures that a negative number, for example, doesn't expand
;; into a |---+---+---| line later
(princ "| ")
(cond ((and too-long
extractp
(funcall extractp item))
(princ (format "[fn:%s]" annalist--fn-counter))
(push (list annalist--fn-counter item formatter
(and src-block-p
(funcall src-block-p item)))
footnotes)
(cl-incf annalist--fn-counter))
(t
(when too-long
;; TODO ellipsis messes up org alignment?
(setq item (format (format "%%.%ss" max-width) item)))
(when formatter
(setq item (funcall formatter item)))
(princ (annalist--safe-pipe (format "%s" item)))))))
(princ "|\n")))
(princ "\n")
;; print footnotes
(dolist (footnote (nreverse footnotes))
(let ((num (car footnote))
(item (cadr footnote))
(use-src-block (cl-cadddr footnote))
(formatter (cl-caddr footnote)))
(princ (format "[fn:%s]\n" num))
(cond (use-src-block
(princ "#+begin_src emacs-lisp\n")
(princ (format "%s\n" item))
(princ "#+end_src\n"))
(t
(princ (format "%s\n" (if formatter
(funcall formatter item)
item)))))
(princ "\n")))))
(defun annalist--print-headings (store depth settings &optional
increase-print-depth)
"Print information from STORE as `org-mode' headings.
DEPTH is the depth of the current heading. SETTINGS contains information about
which entries in STORE are headings and how to print them. If
INCREASE-PRINT-DEPTH is non-nil, increase the level of all printed headings by
one."
(if (>= depth (plist-get settings :table-start-index))
(annalist--print-table store settings)
(let* ((formatter (annalist--item-get settings depth :format))
(priority-keys (annalist--item-get settings depth :prioritize))
(keys (annalist--hash-table-keys store))
(sorter (annalist--item-get settings depth :sort))
(sorted-keys (annalist--merge-lists priority-keys
(if sorter
(sort keys sorter)
keys)))
(predicate (annalist--item-get settings depth :predicate))
(asterisk-num (if increase-print-depth
(+ 2 depth)
(1+ depth))))
(dolist (key sorted-keys)
(let ((next-store (gethash key store)))
(when (and next-store
(or (null predicate)
(funcall predicate key)))
;; print heading
(unless (null key)
(princ (format "%s %s\n" (make-string asterisk-num ?*)
(if formatter
(funcall formatter key)
key))))
(annalist--print-headings next-store (1+ depth) settings
increase-print-depth)))))))
(declare-function org-at-heading-p "org")
(declare-function org-table-align "org-table")
(declare-function outline-next-heading "outline")
(defvar org-startup-folded)
;;;###autoload
(defun annalist-describe (annalist type &optional view)
"Describe information recorded by ANNALIST for TYPE.
For example: (annalist-describe 'general 'keybindings) If VIEW is non-nil, use
those settings for displaying recorded information instead of the defaults."
(let* ((settings (annalist--merge-nested-plists
(annalist--get-view-settings type view)
(annalist--get-tome-settings type)))
(tome (annalist--tome type))
(local-tome (annalist--tome type t))
(name-store (when tome
(gethash annalist tome)))
(local-name-store (when local-tome
(gethash annalist local-tome)))
(output-buffer-name (format "*%s %s*" annalist type))
(view-hooks (annalist--make-list (plist-get settings :hooks)))
(annalist--fn-counter 1))
;; NOTE `with-output-to-temp-buffer' does not change the current buffer (so
;; it is possible to check active keymaps in a predicate function)
(with-output-to-temp-buffer output-buffer-name
(when local-name-store
(princ "* Local\n")
(annalist--print-headings local-name-store 0 settings t))
(when name-store
(when local-name-store
(princ "* Global\n"))
(annalist--print-headings name-store 0 settings local-name-store)))
(when (or local-name-store name-store)
(with-current-buffer output-buffer-name
(let ((org-startup-folded annalist-org-startup-folded))
(org-mode))
(read-only-mode -1)
;; TODO delete empty tables then headings (e.g. if predicate for row
;; fails but predicate for headings didn't)
(while (progn
(while (progn
(forward-line)
(org-at-heading-p)))
(org-table-align)
(outline-next-heading)))
(goto-char (point-min))
(dolist (view-hook view-hooks)
(funcall view-hook))
(run-hooks 'annalist-describe-hook)
(read-only-mode)))))
;; * Type Creation Helpers
;; ** Formatting
(defun annalist-verbatim (item)
"Format ITEM to be surrounded by equal signs."
(format "=%s=" item))
(defun annalist-code (item)
"Format ITEM to be surrounded by tildes."
(format "~%s~" item))
(defun annalist-capitalize (item)
"Convert ITEM to a string and capitalize it."
(capitalize (format "%s" item)))
(defun annalist-compose (&rest fns)
"Return a function composed of FNS.
FNS will be called right to left."
(let ((fn1 (car (last fns)))
(fns (butlast fns)))
(lambda (&rest args)
(cl-reduce #'funcall fns
:from-end t
:initial-value (apply fn1 args)))))
;; ** Sorting
(defun annalist-string-< (x y)
"Return whether X is lexicographiclly less than Y.
The string forms of X and Y as obtained with `format' are compared."
(string< (format "%s" x) (format "%s" y)))
(defun annalist-key-< (x y)
"Return whether X is lexicographically less than Y.
Both are considered to be keys in their bindable forms. Compare their
descriptive forms as obtained with `key-description'"
(string< (key-description x) (key-description y)))
;; ** Source Block Formatting
(defun annalist-multiline-source-blocks ()
"Format Emacs Lisp source blocks in current buffer using lispy.
When lispy is installed, use `lispy-multiline' to format the elisp source blocks
in the current buffer. This is useful since annalist will extract items to
source blocks as a single line."
(when (and (require 'lispy nil t) (require 'ob-core nil t))
(let (content)
(save-excursion
(org-babel-map-src-blocks nil
(when (string= lang "emacs-lisp")
(goto-char beg-body)
(delete-region beg-body end-body)
(with-temp-buffer
(save-excursion
(insert body))
(emacs-lisp-mode)
(while (progn (ignore-errors
(funcall annalist-multiline-function))
(forward-list)
(not (eobp))))
(setq content (buffer-string)))
(insert content)))))))
;; * Keybindings Type
(defun annalist--preprocess-keybinding (record _settings)
"Preprocess RECORD by normalizing the keymap.
If the keymap is 'global and the state is non-nil, set the keymap to be the
actual evil global keymap (e.g. 'evil-normal-state-map)."
(let* ((keymap-sym (nth 0 record))
(state (nth 1 record)))
(when (and state (memq keymap-sym '(global local)))
(setf (nth 1 record) nil)
(setf (nth 0 record)
(if (eq keymap-sym 'global)
(evil-state-property state :keymap)
(evil-state-property state :local-keymap))))
record))
(declare-function evil-state-property "evil-common")
(declare-function evil-get-minor-mode-keymap "evil-core")
(declare-function evil-get-auxiliary-keymap "evil-core")
(cl-defun annalist--get-keymap (state keymap-sym &optional minor-mode)
"Get the keymap corresponding to STATE and KEYMAP-SYM.
If MINOR-MODE is non-nil, KEYMAP-SYM is considered to be a minor mode name.
Return nil if the STATE and KEYMAP-SYM combination is invalid (e.g. the keymap
does not yet exist)."
(let ((keymap (when (boundp keymap-sym)
(symbol-value keymap-sym))))
(if state
(cond ((eq keymap-sym 'global)
(evil-state-property state :keymap t))
(minor-mode
(evil-get-minor-mode-keymap state keymap-sym))
((eq keymap-sym 'local)
(evil-state-property state :local-keymap t))
(t
(when keymap
(evil-get-auxiliary-keymap keymap state t t))))
(if (eq keymap-sym 'global)
(current-global-map)
keymap))))
(defun annalist--lookup-key (keymap key)
"Return the current definition for KEYMAP and KEY.
When a sub-sequence of KEY is bound, return nil instead of 1."
(when (and keymap key)
(let ((def (lookup-key keymap key)))
(if (equal def 1)
nil
def))))
(defcustom annalist-update-previous-key-definition 'on-change
"When to update the stored previous key definition.
When set to 'on-change, update the previous definition only when the old
definition is different from the current one (e.g. evaluating a `define-key'
call twice will not affect the stored previous definition the second time). When
set to nil, only update the previous definition when the key was previously
unbound/nil."
;; can't think of a use case, but add 'always if requested
;; t is equivalent of on-change
:type '(choice
(const :tag "When definition has changed" on-change)
(const :tag "When the key was previously unbound" nil)))
(defun annalist--previous-value (old-record old-val current-val new-val
&optional test)
"Update a \"previous\" value for something.
OLD-RECORD is the previous record or nil if there is no previous record. OLD-VAL
is the currently stored \"previous\" value. CURRENT-VAL is the actual current
value for the thing (which could potentially be different from the stored
current value if not all functions that change the thing call function
`annalist-record'). NEW-VAL is the new value that the thing will be changed to.
TEST is the test to used to compare values (or `equal'). If there is no
OlD-RECORD or if NEW-VAL is still equal to CURRENT-VAL and
`annalist-update-previous-key-definition' is non-nil or if OLD-VAL is nil and
`annalist-update-previous-key-definition' is nil, return CURRENT-VAL. Otherwise
return OLD-VAL."
(if (or (null old-record)
(if annalist-update-previous-key-definition
(not (funcall (or test #'equal)
current-val new-val))
(null old-val)))
current-val
old-val))
(defun annalist--update-keybinding (old-record new-record settings)
"Using the information in OLD-RECORD update NEW-RECORD.
The previous definition item in NEW-RECORD will updated based on the old
recorded previous definition (which may not exist), the actual/current
definition, and the new definition. SETTINGS is used to check for a test
function for comparing key definitions."
(let* ((new-metadata (nth (plist-get settings :metadata-index) new-record))
(old-previous-def (nth 4 old-record))
(keymap-sym (nth 0 new-record))
(state (nth 1 new-record))
(key (nth 2 new-record))
(keymap (or (plist-get new-metadata :keymap)
(annalist--get-keymap
state
keymap-sym
(plist-get new-metadata :minor-mode))))
(current-def (when keymap
(annalist--lookup-key keymap key)))
(new-def (nth 3 new-record))
(test (annalist--test settings 'definition)))
;; keybinding may still be deferred
;; TODO if defererd, record may keep an incorrect nil previous-def
(when current-def
(setf (nth 4 new-record)
(annalist--previous-value old-record old-previous-def current-def
new-def test)))
new-record))
(defun annalist--valid-keymap-p (keymap-sym)
"Return whether KEYMAP-SYM is bound.
This is necessary since it is possible to record keybindings before they are
actually defined (e.g. keybindings may be deferred until the keymap exists).
'local and 'global are handled specially (return non-nil)."
(or (memq keymap-sym '(local global))
(boundp keymap-sym)))
(defun annalist--active-keymap-p (keymap-sym)
"Return whether KEYMAP-SYM's value is an active keymap."
(or (memq keymap-sym '(local global))
(and (boundp keymap-sym)
;; TODO handling case where keymap-sym is a minor mode
(memq (symbol-value keymap-sym) (current-active-maps)))))
(declare-function evil-state-p "evil-core")
(defun annalist--valid-state-p (state)
"Return whether STATE is valid."
(or (null state)
(and (featurep 'evil)
(evil-state-p state))))
(defvar evil-local-mode)
(defun annalist--valid-state-and-evil-on-p (state)
"Return whether STATE is valid and variable `evil-local-mode' is non-nil."
(or (null state)
(and (annalist--valid-state-p state) evil-local-mode)))
(annalist-define-tome 'keybindings
(list :primary-key '(keymap state key)
:table-start-index 2
:preprocess #'annalist--preprocess-keybinding
:record-update #'annalist--update-keybinding
'keymap
'state
'key
'definition
'previous-definition))
(annalist-define-view 'keybindings 'default
(list (list 'keymap :format #'annalist-code)
(list 'state :format #'annalist-capitalize)
(list 'key :format (annalist-compose #'annalist-verbatim
#'key-description))
(list 'definition :format #'annalist-code)
(list 'previous-definition :title "Previous" :format #'annalist-code)
:defaults (list :extractp #'listp
:src-block-p #'listp)
:hooks #'annalist-multiline-source-blocks))
(annalist-define-view 'keybindings 'valid
(list (list 'keymap
:predicate #'annalist--valid-keymap-p)
(list 'state
:predicate #'annalist--valid-state-p))
:inherit 'default)
(annalist-define-view 'keybindings 'active
(list (list 'keymap
:predicate #'annalist--active-keymap-p)
(list 'state
:predicate #'annalist--valid-state-and-evil-on-p))
:inherit 'default)
;; * Settings Type
;; TODO
;; * Hooks Type
;; TODO
;; * Advice Type
;; TODO
(provide 'annalist)
;;; annalist.el ends here
annalist-20190929.207/annalist-pkg.el 0000664 0001750 0001750 00000000700 14133447050 015513 0 ustar kimr kimr (define-package "annalist" "20190929.207" "Record and display information such as keybindings"
'((emacs "24.4")
(cl-lib "0.5"))
:commit "134fa3f0fb91a636a1c005c483516d4b64905a6d" :authors
'(("Fox Kiester" . "[email protected]"))
:maintainer
'("Fox Kiester" . "[email protected]")
:keywords
'("convenience" "tools" "keybindings" "org")
:url "https://github.com/noctuid/annalist.el")
;; Local Variables:
;; no-byte-compile: t
;; End:
annalist-20190929.207/annalist.info 0000664 0001750 0001750 00000047634 14133447050 015310 0 ustar kimr kimr This is annalist.info, produced by makeinfo version 6.7 from
annalist.texi.
INFO-DIR-SECTION Emacs
START-INFO-DIR-ENTRY
* Annalist: (annalist). Record and display information such as keybindings.
END-INFO-DIR-ENTRY
File: annalist.info, Node: Top, Next: Usage, Up: (dir)
Annalist User Manual
********************
file:https://melpa.org/packages/annalist-badge.svg
(https://melpa.org/#/annalist)
https://travis-ci.org/noctuid/annalist.el.svg?branch=master
(https://travis-ci.org/noctuid/annalist.el)
Incessant wind sweeps the plain. It murmurs on across grey stone,
carrying dust from far climes to nibble eternally at the memorial
pillars. There are a few shadows out there still but they are the
weak and the timid and the hopelessly lost.
It is immortality of a sort.
Memory is immortality of a sort.
In the night, when the wind dies and silence rules the place of
glittering stone, I remember. And they all live again.
‘annalist.el’ is a library that can be used to record information and
later print that information using ‘org-mode’ headings and tables. It
allows defining different types of things that can be recorded (e.g.
keybindings, settings, hooks, and advice) and supports custom filtering,
sorting, and formatting. ‘annalist’ is primarily intended for use in
other packages like ‘general’ and ‘evil-collection’, but it can also be
used directly in a user’s configuration.
[https://user-images.githubusercontent.com/4250696/63480582-64e2cb00-c460-11e9-9571-706b5b96992c]
* Menu:
* Usage::
— The Detailed Node Listing —
Usage
* Disabling Annalist::
* Terminology::
* Settings::
* Defining New Types::
* Defining Views::
* Recording::
* Describing::
* Helper Functions::
* Builtin Types::
Defining New Types
* Type Top-level Settings::
* Type Item Settings::
* ‘:record-update’, ‘:preprocess’, and ‘:postprocess’ Settings Argument: record-update preprocess and postprocess Settings Argument.
Defining Views
* View Top-level Settings::
* View Item Settings::
Helper Functions
* List Helpers::
* Formatting Helpers::
* Sorting Helpers::
Builtin Types
* Keybindings Type::
File: annalist.info, Node: Usage, Prev: Top, Up: Top
1 Usage
*******
* Menu:
* Disabling Annalist::
* Terminology::
* Settings::
* Defining New Types::
* Defining Views::
* Recording::
* Describing::
* Helper Functions::
* Builtin Types::
File: annalist.info, Node: Disabling Annalist, Next: Terminology, Up: Usage
1.1 Disabling Annalist
======================
What fool always has his nose in everywhere because he thinks he
has to know so he can record it in his precious Annals?
If you use a library that uses ‘annalist’ (e.g. ‘evil-collection’ or
‘general’) but don’t need it’s functionality during init or at all, you
can set ‘annalist-record’ to nil to shave some milliseconds off of your
init time (especially if you have a lot of keybindings). Alternatively,
if you only want to prevent ‘annalist’ from recording certain things or
have it only record certain things, you can configure
‘annalist-record-blacklist’ or ‘annalist-record-whitelist’ respectively.
File: annalist.info, Node: Terminology, Next: Settings, Prev: Disabling Annalist, Up: Usage