forked from rswgnu/hyperbole
-
Notifications
You must be signed in to change notification settings - Fork 0
/
hyrolo.el
2014 lines (1844 loc) · 82.5 KB
/
hyrolo.el
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
;;; hyrolo.el --- Hierarchical, multi-file, easy-to-use contact management system -*- lexical-binding: t; -*-
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 7-Jun-89 at 22:08:29
;; Last-Mod: 27-Nov-22 at 23:45:24 by Bob Weiner
;;
;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;; Commentary:
;;
;; This is Hyperbole's advanced rolo system, HyRolo, for convenient
;; management of hierarchical, record-oriented information. Most
;; often this is used for contact management but it can quickly be
;; adapted to most any record-oriented lookup task, for fast retrieval.
;;
;; See all the autoloaded functions herein for interactive commands.
;; See the Info manual entry "(hyperbole)HyRolo" for usage information.
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
(require 'custom) ;; For defface.
(require 'hversion)
(require 'hmail)
(require 'set)
(require 'sort)
(require 'xml)
;; Quiet byte compiler warnings for these free variables.
(eval-when-compile
(unless (require 'bbdb nil t)
(defvar bbdb-file nil))
(unless (require 'google-contacts nil t)
(defvar google-contacts-buffer-name nil)))
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(defvar org-roam-directory)
(defvar org-roam-db-autosync-mode)
(defvar markdown-regex-header)
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
(defgroup hyperbole-rolo nil
"Hyperbole Rolo hierarchical contact manager customizations."
:group 'hyperbole)
(defcustom hyrolo-date-format "%m/%d/%Y"
"*Format of date string used in Rolo automatic date stamps.
Default is American style. See documentation of the function
`format-time-string' for format options."
:type 'string
:group 'hyperbole-rolo)
(defvar hyrolo-display-format-function
(lambda (entry)
(concat (replace-regexp-in-string "[ \t\n\r]+\\'" "" entry nil t) "\n"))
"*Function of one argument which modifies the string for display.
The argument is a rolo entry string.")
(defcustom hyrolo-email-format "%s\t\t<%s>"
"*Format string to use when adding an entry with e-mail addr from a mail msg.
It must contain a %s indicating where to put the entry name and a second
%s indicating where to put the e-mail address."
:type 'string
:group 'hyperbole-rolo)
(defvar hyrolo-entry-name-regexp "[-_a-zA-Z0-9@.]+\\( ?, ?[-_a-zA-Z0-9@.]+\\)?"
"*Regexp matching a hyrolo entry name after matching to `hyrolo-entry-regexp'.")
(defcustom hyrolo-file-suffix-regexp "\\.\\(kotl\\|md\\|org\\|otl\\)$"
"File suffix regexp used to select files to search with HyRolo."
:type 'string
:group 'hyperbole-rolo)
(defcustom hyrolo-find-file-function #'find-file
"*Function to interactively display a `hyrolo-file-list' file for editing.
Use the `hyrolo-edit' function instead to edit a new or existing entry."
:type 'function
:group 'hyperbole-rolo)
(defcustom hyrolo-find-file-noselect-function #'find-file-noselect
"*Function used by HyRolo to read `hyrolo-file-list' files into Emacs."
:type 'function
:group 'hyperbole-rolo)
(defcustom hyrolo-google-contacts-flag t
"*Non-nil means search Google Contacts on each hyrolo query.
The google-contact package must be loaded and a gpg encryption
executable must be found as well (for Oauth security)."
:type 'boolean
:group 'hyperbole-rolo)
(defvar hyrolo-next-match-function #'hyrolo-next-regexp-match
"Value is the function to find next match within a HyRolo file.
Must take two arguments, `match-pattern' and `headline-only-flag'.
Must leave point within any matched entry or return nil when no
match is found.")
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(declare-function google-contacts "ext:google-contacts")
(declare-function google-contacts-add-margin-to-text "ext:google-contacts")
(declare-function google-contacts-build-node-list "ext:google-contacts")
(declare-function google-contacts-data "ext:google-contacts")
(declare-function google-contacts-make-buffer "ext:google-contacts")
(declare-function google-contacts-margin-element "ext:google-contacts")
(declare-function google-contacts-oauth-token "ext:google-contacts")
(declare-function xml-node-child-string "ext:google-contacts")
(declare-function xml-node-get-attribute-type "ext:google-contacts")
(defvar google-contacts-history)
(defvar google-contacts-expire-time)
(defvar google-contacts-query-string)
(declare-function hyrolo-fgrep-logical "hyrolo-logic")
(defvar hproperty:highlight-face)
(defun hyrolo-google-contacts-p ()
"Non-nil means google contacts package is available and feature is enabled.
Requires `hyrolo-google-contacts-flag' set as non-nil and
google-contacts package and gpg executables to be available for
use."
(and hyrolo-google-contacts-flag
(featurep 'google-contacts)
(boundp 'google-contacts-buffer-name)
;; If no gpg encryption executable, Oauth login to Google will fail.
(or (executable-find "gpg2") (executable-find "gpg"))))
;; '("~/.rolo.otl" "~/.rolo.org")
;;;###autoload
(defun hyrolo-initialize-file-list ()
"Initialize the list of files used for HyRolo search."
(interactive)
(let* ((gcontacts (when (hyrolo-google-contacts-p) google-contacts-buffer-name))
(ms "~/.rolo.otl")
(posix "~/.rolo.otl")
(list (delq nil (if (and (boundp 'bbdb-file) (stringp bbdb-file))
(if hyperb:microsoft-os-p
(list ms bbdb-file gcontacts)
(list "~/.rolo.otl" bbdb-file gcontacts))
(if hyperb:microsoft-os-p (list ms gcontacts) (list posix gcontacts))))))
(setq hyrolo-file-list list)
(when (called-interactively-p 'interactive)
(message "HyRolo Search List: %S" list))
list))
(define-obsolete-variable-alias 'rolo-file-list 'hyrolo-file-list "06.00")
(defcustom hyrolo-file-list (hyrolo-initialize-file-list)
"*List of files containing rolo entries.
The first file should be a user-specific rolo file, typically in the home
directory.
A hyrolo-file consists of:
(1) an optional header beginning with and ending with a line which matches
hyrolo-hdr-regexp;
(2) one or more rolo entries which each begin with
hyrolo-entry-regexp and may be nested."
:group 'hyperbole-rolo
:type '(repeat file))
(defcustom hyrolo-highlight-face 'match
"*Face used to highlight rolo search matches."
:type 'face
:initialize #'custom-initialize-default
:group 'hyperbole-rolo)
(defcustom hyrolo-kill-buffers-after-use nil
"*Non-nil means kill rolo file buffers after searching them for entries.
Only unmodified buffers are killed."
:type 'boolean
:group 'hyperbole-rolo)
(defcustom hyrolo-save-buffers-after-use t
"*Non-nil means save rolo file after an entry is killed."
:type 'boolean
:group 'hyperbole-rolo)
;; Insert or update the entry date each time an entry is added or edited.
(add-hook 'hyrolo-add-hook #'hyrolo-set-date)
(add-hook 'hyrolo-edit-hook #'hyrolo-set-date)
(defvar hyrolo-yank-reformat-function nil
"*A function of two arguments, START and END, invoked after a hyrolo-yank.
It should reformat the region given by the arguments to some preferred style.
Default value is nil, meaning no reformmating is done.")
;;; ************************************************************************
;;; Commands
;;; ************************************************************************
;;;###autoload
(defun hyrolo-add (name &optional file)
"Add a new entry in personal rolo for NAME.
Last name first is best, e.g. \"Smith, John\".
With prefix argument, prompts for optional FILE to add entry within.
NAME may be of the form: parent/child to insert child below a parent
entry which begins with the parent string."
(interactive
(progn
(unless (fboundp 'mail-fetch-field)
(require 'mail-utils))
(let* ((lst (hyrolo-name-and-email))
(name (car lst))
(email (car (cdr lst)))
(entry (read-string "Name to add to rolo: "
(or name email))))
(list (if (and email name
(string-match (concat "\\`" (regexp-quote entry)) name))
(format hyrolo-email-format entry email) entry)
current-prefix-arg))))
(when (or (not (stringp name)) (string-equal name ""))
(error "(hyrolo-add): Invalid name: `%s'" name))
(when (and (called-interactively-p 'interactive) file)
(setq file (completing-read "File to add to: "
(mapcar #'list hyrolo-file-list))))
(unless file
(setq file (car hyrolo-file-list)))
(cond ((and file (or (not (stringp file)) (string-equal file "")))
(error "(hyrolo-add): Invalid file: `%s'" file))
((and (file-exists-p file) (not (file-readable-p file)))
(error "(hyrolo-add): File not readable: `%s'" file))
((not (file-writable-p file))
(error "(hyrolo-add): File not writable: `%s'" file)))
(set-buffer (or (get-file-buffer file)
(hyrolo-find-file-noselect file)))
(when (called-interactively-p 'interactive)
(message "Locating insertion point for `%s'..." name))
(let ((parent "")
(level "")
(entry-regexp (default-value 'hyrolo-entry-regexp))
end)
(hyrolo-widen)
(goto-char (point-min))
;; If name includes slash level separator character, walk down
;; existing matching tree of entries to find insertion point.
(while (string-match "\\`[^\]\[/<>{}\"]*/" name)
(setq end (1- (match-end 0))
parent (substring name 0 end)
name (substring name (min (1+ end) (length name))))
(if (re-search-forward
(concat entry-regexp (regexp-quote parent) "\\s-") nil t)
(setq level (match-string-no-properties hyrolo-entry-group-number))
(error "(hyrolo-add): Insertion failed, `%s' parent entry not found in \"%s\""
parent file)))
(narrow-to-region (point) (progn (hyrolo-to-entry-end t) (point)))
(let* ((name-level (concat level "*"))
(level-len (length name-level))
(first-char (aref name 0))
(entry "")
(entry-spc "")
(entry-level-len)
(match)
(again t))
;; Speed up entry insertion point location if this is a first-level
;; entry by moving to an entry with the same (or nearest) first character
;; to that of `name'.
(if (and (= level-len 1)
(equal entry-regexp "^\\(\\*+\\)\\([ \t]+\\)"))
(let ((case-fold-search))
(goto-char (point-min))
(if (re-search-forward (concat entry-regexp
(regexp-quote (char-to-string first-char)))
nil t)
(goto-char (match-beginning 0))
(goto-char (point-max))
(when (and (> first-char ?0)
(re-search-backward
(concat "^\\*[ \t]+["
(substring
"0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_`abcdefghijklmnopqrstuvwxyz"
0 (min (- first-char ?0) 62))
"])")
nil t))
(goto-char (match-end 0))
(hyrolo-to-entry-end t)
;; Now at the insertion point, immediately after
;; the last existing entry whose first character
;; is less than that of `name'. Setting `again'
;; to nil prevents further searching for an
;; insertion point.
(setq again nil))))
(goto-char (point-min)))
(while (and again (re-search-forward entry-regexp nil 'end))
(setq entry-level-len (length (match-string-no-properties hyrolo-entry-group-number)))
(if (/= entry-level-len level-len)
(hyrolo-to-entry-end t)
(setq entry-spc (match-string-no-properties hyrolo-entry-trailing-space-group-number)
entry (buffer-substring-no-properties (point)
(save-excursion
(re-search-forward hyrolo-entry-name-regexp nil t)
(point))))
(when (and (eq major-mode #'markdown-mode)
(string-match "\\`.*#+" entry-spc))
(setq entry-spc (substring entry-spc (length (match-string 0 entry-spc)))))
(cond ((string-lessp entry name)
(hyrolo-to-entry-end t))
((string-lessp name entry)
(setq again nil) (beginning-of-line))
(t ;; found existing entry matching name
(setq again nil match t)))))
(setq buffer-read-only nil)
(unless match
(unless (zerop (current-column))
(insert "\n"))
(insert (concat level "*")
(if (string-equal entry-spc "") " " entry-spc)
name "\n")
(backward-char 1))
;; hyrolo-to-buffer may move point from its desired location, so
;; restore it.
(let ((opoint (point)))
(hyrolo-widen)
(hyrolo-to-buffer (current-buffer))
(goto-char opoint))
(when (derived-mode-p 'kotl-mode)
(kotl-mode:to-valid-position))
(run-hooks 'hyrolo-add-hook)
(when (called-interactively-p 'interactive)
(message "Edit entry at point.")))))
;;;###autoload
(defun hyrolo-display-matches (&optional display-buf return-to-buffer)
"Display optional DISPLAY-BUF buffer of previously found rolo matches.
If DISPLAY-BUF is nil, use the value in `hyrolo-display-buffer'.
Second arg RETURN-TO-BUFFER is the buffer to leave point within
after the display."
(interactive)
(unless display-buf
(setq display-buf (get-buffer hyrolo-display-buffer)))
(unless display-buf
(error "(hyrolo-display-matches): Search the rolo first"))
;; Save current window configuration if rolo match buffer is not
;; displayed in one of the windows already.
(or
;; Handle both Emacs V18 and V19 versions of get-buffer-window.
(condition-case ()
(get-buffer-window display-buf (selected-frame))
(error (get-buffer-window display-buf)))
(setq hyrolo--wconfig (current-window-configuration)))
(hyrolo-to-buffer display-buf)
(when (fboundp 'hproperty:but-create)
(hproperty:but-create))
(hyrolo-shrink-window)
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(run-hooks 'hyrolo-display-hook)
;; Leave point in match buffer unless a specific RETURN-TO-BUFFER has
;; been specified. Use {q} to quit and restore display.
(when return-to-buffer
(hyrolo-to-buffer return-to-buffer)))
;;;###autoload
(defun hyrolo-edit (&optional name file)
"Edit a rolo entry given by optional NAME within `hyrolo-file-list'.
With prefix argument, prompt for optional FILE within which to
locate entry. With no NAME arg, simply displays FILE or first
entry in `hyrolo-file-list' in an editable mode. NAME may be of
the form: parent/child to edit child below a parent entry which
begins with the parent string."
(interactive "sEdit rolo entry named: \nP")
(when (string-equal name "")
(setq name nil))
(and name (not (stringp name))
(error "(hyrolo-edit): Invalid name: `%s'" name))
(when (and (called-interactively-p 'interactive) current-prefix-arg)
(if (= (length hyrolo-file-list) 1)
(setq file (car hyrolo-file-list))
(setq file (completing-read "Entry's File: "
(mapcar #'list hyrolo-file-list)))))
(let ((found-point) (file-list (if file (list file) hyrolo-file-list)))
(or file (setq file (car file-list)))
(if (null name)
(progn (if (not (file-writable-p file))
(error "(hyrolo-edit): File not writable: `%s'" file))
(find-file-other-window file) (setq buffer-read-only nil))
(if (setq found-point (hyrolo-to name file-list))
(progn
(setq file buffer-file-name)
(if (file-writable-p file)
(setq buffer-read-only nil)
(message
"(hyrolo-edit): Entry found but file not writable: `%s'" file)
(beep))
(hyrolo-to-buffer (current-buffer)))
(message "(hyrolo-edit): `%s' not found." name)
(beep)
(hyrolo-to-buffer (or (get-file-buffer (car file-list))
(hyrolo-find-file-noselect (car file-list))))
(setq buffer-read-only nil))
(hyrolo-widen)
;; hyrolo-to-buffer may have moved point from its desired location, so
;; restore it.
(when found-point
(goto-char found-point))
(when (derived-mode-p 'kotl-mode)
(kotl-mode:to-valid-position))
(run-hooks 'hyrolo-edit-hook))))
(defun hyrolo-edit-entry ()
"Edit the source entry of the rolo match buffer entry at point.
Return entry name if found, else nil."
(interactive)
(let ((name (hyrolo-name-at))
src)
(if name
(progn (setq src (hbut:to-key-src t))
(cond ((and (boundp 'bbdb-file) (stringp bbdb-file) (equal src (expand-file-name bbdb-file)))
;; For now, can't edit an entry from the bbdb database, signal an error.
(error "(hyrolo-edit-entry): BBDB entries are not editable"))
((and (hyrolo-google-contacts-p) (equal src (get-buffer google-contacts-buffer-name)))
;; For now, can't edit an entry from Google Contacts, signal an error.
(error "(hyrolo-edit-entry): Google Contacts entries are not editable"))
((stringp src)
(hyrolo-edit name src)
name)
(t
(error "(hyrolo-edit-entry): Move to an entry to edit it"))))
(error "(hyrolo-edit-entry): Move to an entry to edit it"))))
;;;###autoload
(defun hyrolo-fgrep (string &optional max-matches hyrolo-file count-only headline-only no-display)
"Display rolo entries matching STRING or a logical match expression.
Return count of matches.
To a maximum of optional prefix arg MAX-MATCHES, in file(s) from optional
HYROLO-FILE or `hyrolo-file-list'. Default is to find all matching entries.
Each entry is displayed with all of its sub-entries. Optional COUNT-ONLY
non-nil skips retrieval of matching entries. Optional HEADLINE-ONLY searches
only the first line of entries, not the full text. Optional NO-DISPLAY non-nil
retrieves entries but does not display them.
Nil value of MAX-MATCHES means find all matches, t value means find all
matches but omit file headers, negative values mean find up to the inverse of
that number of entries and omit file headers.
Return number of entries matched. See also documentation for the variable
`hyrolo-file-list' and the function `hyrolo-fgrep-logical' for documentation on
the logical sexpression matching."
(interactive "sFind rolo string (or logical sexpression): \nP")
(setq string (string-trim string "\"" "\""))
(let ((total-matches 0))
(if (string-match "\(\\(and\\|or\\|xor\\|not\\)\\>" string)
(progn
;; Search string contains embedded logic operators.
;; First try to match logical sexpression within a single
;; subentry to minimize entries displayed. If no match,
;; then match across ancestors and descendants.
(when (zerop (setq total-matches (hyrolo-fgrep-logical string count-only nil t)))
(hyrolo-fgrep-logical string count-only t t)))
(setq total-matches (hyrolo-grep (regexp-quote string)
max-matches hyrolo-file count-only headline-only no-display)))
(if (called-interactively-p 'interactive)
(message "%s matching entr%s found in rolo."
(if (= total-matches 0) "No" total-matches)
(if (= total-matches 1) "y" "ies")))
total-matches))
;;;###autoload
(defun hyrolo-find-file (&optional file find-function &rest args)
"Select and edit a FILE in `hyrolo-file-list' with FIND-FUNCTION.
Default to the first listed file when not given a prefix arg."
(interactive "P")
(when (or (called-interactively-p 'interactive)
(null file))
(if (or (= (length hyrolo-file-list) 1)
(not current-prefix-arg))
(setq file (car hyrolo-file-list))
(setq file (completing-read "Edit HyRolo file: "
(mapcar #'list hyrolo-file-list)))))
(when (stringp file)
(prog1 (apply (or find-function hyrolo-find-file-function) file args)
(setq buffer-read-only nil))))
;;;###autoload
(defun hyrolo-find-file-noselect (&optional file)
"HyRolo function to read a FILE in literally.
It uses the setting of `hyrolo-find-file-noselect-function'."
(let (enable-local-variables)
(if (string-match "\\.org$" file)
(let ((find-file-literally t))
(hyrolo-find-file file hyrolo-find-file-noselect-function nil t))
(hyrolo-find-file file hyrolo-find-file-noselect-function))))
(defun hyrolo-forward-visible-line (&optional arg)
"Move forward by optional ARG lines (default = 1).
Ignore currently invisible newlines only.
If ARG is negative, move backward -ARG lines.
If ARG is zero, move to the beginning of the current line."
(unless arg
(setq arg 1))
(forward-visible-line arg))
;;;###autoload
(defun hyrolo-grep (regexp &optional max-matches hyrolo-file-or-bufs count-only headline-only no-display)
"Display rolo entries matching REGEXP and return count of matches.
To a maximum of prefix arg MAX-MATCHES, in buffer(s) from
optional HYROLO-FILE-OR-BUFS or hyrolo-file-list. Default is to
find all matching entries. Each entry is displayed with all of
its sub-entries. Optional COUNT-ONLY non-nil means don't
retrieve and don't display matching entries. Optional
HEADLINE-ONLY searches only the first line of entries, not the
full text. Optional NO-DISPLAY non-nil retrieves entries but
does not display.
Nil value of MAX-MATCHES means find all matches, t value means find all matches
but omit file headers, negative values mean find up to the inverse of that
number of entries and omit file headers.
Return number of entries matched. See also documentation for the variable
\`hyrolo-file-list'."
(interactive "sFind rolo regular expression: \nP")
(unless (or (integerp max-matches) (memq max-matches '(nil t)))
(setq max-matches (prefix-numeric-value max-matches)))
(let ((hyrolo-file-list
(cond ((null hyrolo-file-or-bufs) hyrolo-file-list)
((listp hyrolo-file-or-bufs) hyrolo-file-or-bufs)
((list hyrolo-file-or-bufs))))
(case-fold-search t)
(display-buf (unless count-only
(hyrolo-set-display-buffer)))
(total-matches 0)
(num-matched 0)
(inserting (or (eq max-matches t)
(and (integerp max-matches) (< max-matches 0))))
(hyrolo-entry-regexps (set:create))
(outline-regexps (set:create))
(file)
hyrolo-buf)
(unless count-only
(setq buffer-read-only nil)
(unless inserting
(erase-buffer)))
(while (and (setq file (car hyrolo-file-list))
(or (not (integerp max-matches))
(< total-matches (max max-matches (- max-matches)))))
(setq hyrolo-buf (hyrolo-find-file-noselect file)
hyrolo-entry-regexps (set:add (buffer-local-value 'hyrolo-entry-regexp hyrolo-buf)
hyrolo-entry-regexps)
outline-regexps (set:add (buffer-local-value 'outline-regexp hyrolo-buf)
outline-regexps)
hyrolo-file-list (cdr hyrolo-file-list)
num-matched (cond ((and (featurep 'bbdb) (equal file bbdb-file))
(hyrolo-bbdb-grep-file file regexp max-matches count-only))
((and (hyrolo-google-contacts-p) (equal file google-contacts-buffer-name))
(hyrolo-retrieve-google-contacts (regexp-quote regexp))
(hyrolo-google-contacts-grep-file file regexp max-matches count-only))
(t (hyrolo-grep-file file regexp max-matches count-only headline-only)))
total-matches (+ total-matches num-matched))
(when (integerp max-matches)
(setq max-matches
(if (>= max-matches 0)
(- max-matches num-matched)
(+ max-matches num-matched)))))
(unless (or count-only no-display inserting (= total-matches 0))
(set-buffer display-buf)
(when hyrolo-entry-regexps
(setq hyrolo-entry-regexp (string-join hyrolo-entry-regexps "\\|"))
(unless (string-prefix-p hyrolo-hdr-regexp hyrolo-entry-regexp)
(setq hyrolo-entry-regexp (concat hyrolo-hdr-regexp "\\|" hyrolo-entry-regexp))))
(when outline-regexps
(setq outline-regexp (string-join outline-regexps "\\|"))
(unless (string-prefix-p hyrolo-hdr-regexp outline-regexp)
(setq outline-regexp (concat hyrolo-hdr-regexp "\\|" outline-regexp))))
(hyrolo-display-matches display-buf))
(when (called-interactively-p 'interactive)
(message "%s matching entr%s found in rolo."
(if (= total-matches 0) "No" total-matches)
(if (= total-matches 1) "y" "ies")))
total-matches))
;;;###autoload
(defun hyrolo-grep-or-fgrep (&optional arg)
"Grep over `hyrolo-file-list' and display the results as rolo entries.
With optional prefix ARG, do an fgrep string match instead of a regexp match."
(interactive "P")
(call-interactively (if arg 'hyrolo-fgrep 'hyrolo-grep)))
(defun hyrolo-hide-subtree ()
"Move back to the start of current subtree and hide everything after the heading.
Necessary, since with reveal-mode active, outline-hide-subtree works
only if on the heading line of the subtree."
(interactive)
(let ((opoint (point)))
(forward-line 0)
(unless (looking-at outline-regexp)
(outline-previous-visible-heading 1))
(if (looking-at outline-regexp)
(outline-hide-subtree)
(goto-char opoint))))
(defun hyrolo-isearch (&optional arg)
"Interactively search forward for the next occurrence of current match string.
Then add characters to further narrow the search. With optional
prefix ARG non-nil, search for the current match regular
expression rather than string."
(interactive "P")
(if arg
(hyrolo-isearch-regexp)
(hyrolo-verify)
(if hyrolo-match-regexp
(progn (setq unread-command-events
(append unread-command-events (string-to-list (regexp-quote hyrolo-match-regexp))))
(let ((case-fold-search t))
(isearch-forward)))
(error (substitute-command-keys "(hyrolo-isearch): Use {\\[hyrolo-grep-or-fgrep]} to do an initial search")))))
(defun hyrolo-isearch-regexp (&optional arg)
"Interactively search forward for the next occurrence of current match string.
Then add characters to further narrow the search. With optional
prefix ARG non-nil, search for the current match regular
expression rather than string."
(interactive "P")
(if arg
(hyrolo-isearch)
(hyrolo-isearch-for-regexp hyrolo-match-regexp t)))
(defun hyrolo-verify ()
"Verify point is in a HyRolo or HyNote match buffer."
(when (not (member (buffer-name) (list hyrolo-display-buffer
(and (car hyrolo-file-list)
(file-name-nondirectory (car hyrolo-file-list)))
(when (boundp 'hynote-display-buffer)
hynote-display-buffer)
(when (boundp 'hynote-file-list)
(and (car hynote-file-list)
(file-name-nondirectory (car hynote-file-list)))))))
(error "(HyRolo): Use this command in HyRolo/HyNote match buffers or primary file buffers")))
;;;###autoload
(defun hyrolo-kill (name &optional file)
"Kill a rolo entry given by NAME within `hyrolo-file-list'.
With prefix argument, prompts for optional FILE to locate entry within.
NAME may be of the form: parent/child to kill child below a parent entry
which begins with the parent string.
Return t if entry is killed, nil otherwise."
(interactive "sKill rolo entry named: \nP")
(if (or (not (stringp name)) (string-equal name "") (string-match "\\*" name))
(error "(hyrolo-kill): Invalid name: `%s'" name))
(if (and (called-interactively-p 'interactive) current-prefix-arg)
(setq file (completing-read "Entry's File: "
(mapcar #'list hyrolo-file-list))))
(let ((file-list (if file (list file) hyrolo-file-list))
(killed))
(or file (setq file (car file-list)))
(if (hyrolo-to name file-list)
(progn
(setq file buffer-file-name)
(if (file-writable-p file)
(let ((kill-op
(lambda (start level-len)
(kill-region
start (hyrolo-to-entry-end t))
(setq killed t)
(hyrolo-save-buffer)
(hyrolo-kill-buffer)))
(case-fold-search)
start end level-len)
(setq buffer-read-only nil)
(re-search-backward hyrolo-entry-regexp nil t)
(setq end (match-end 0))
(setq start (line-beginning-position)
level-len (length (buffer-substring-no-properties start end)))
(goto-char end)
(skip-chars-forward " \t")
(if (called-interactively-p 'interactive)
(let ((entry-line (buffer-substring-no-properties
(point)
(min (+ (point) 60)
(progn (end-of-line) (point))))))
(if (y-or-n-p (format "Kill `%s...'? " entry-line))
(progn
(funcall kill-op start level-len)
(message "Killed"))
(message "Aborted")))
(funcall kill-op start level-len)))
(message
"(hyrolo-kill): Entry found but file not writable: `%s'" file)
(beep)))
(message "(hyrolo-kill): `%s' not found." name)
(beep))
killed))
(defun hyrolo-locate ()
"Interactively search for an entry beginning with a set of search characters."
(interactive)
(hyrolo-isearch-for-regexp hyrolo-entry-regexp nil))
(defun hyrolo-mail-to ()
"Start composing mail addressed to the first e-mail address at or after point."
(interactive)
(let ((opoint (point)) button)
(skip-chars-backward "^ \t\n\r<>")
(if (and (re-search-forward mail-address-regexp nil t)
(goto-char (match-beginning 1))
(setq button (ibut:at-p)))
(hui:hbut-act button)
(goto-char opoint)
(beep)
(message "(hyrolo-mail-to): Invalid buffer or no e-mail address found"))))
(defun hyrolo-next-match ()
"Move point forward to the start of the next rolo search match.
Raise an error if a match is not found."
(interactive)
(hyrolo-verify)
(let ((start (point))
(case-fold-search t)
(prior-regexp-search (stringp hyrolo-match-regexp)))
(when (and prior-regexp-search (looking-at hyrolo-match-regexp))
(goto-char (match-end 0)))
(if (and prior-regexp-search (re-search-forward hyrolo-match-regexp nil t))
(goto-char (match-beginning 0))
(goto-char start)
(if prior-regexp-search
(error
"(hyrolo-next-match): No following matches for \"%s\"" hyrolo-match-regexp)
(error (substitute-command-keys "(hyrolo-next-match): Use {\\[hyrolo-grep-or-fgrep]} to do a search first"))))))
(defun hyrolo-overview (levels-to-show)
"Show the first line of all levels of rolo matches.
With a prefix argument of LEVELS-TO-SHOW > 0, show the first
lines of entries only to that depth."
(interactive "P")
(hyrolo-verify)
;; Use {t} to display top-level cells only.
(if (or (null levels-to-show)
(if (called-interactively-p 'interactive)
(progn (setq levels-to-show (prefix-numeric-value current-prefix-arg))
(<= levels-to-show 0))
(not (integerp levels-to-show))))
(setq levels-to-show 100))
(hyrolo-hide-subtree) ;; Ensure reveal-mode does not expand current entry.
(hyrolo-show-levels levels-to-show))
(defun hyrolo-previous-match ()
"Move point back to the start of the previous rolo search match.
This could be the current match if point is past its `hyrolo-match-regexp'.
Raise an error if a match is not found."
(interactive)
(hyrolo-verify)
(if hyrolo-match-regexp
(let ((case-fold-search t))
(or (re-search-backward hyrolo-match-regexp nil t)
(error
"(hyrolo-previous-match): No prior matches for \"%s\"" hyrolo-match-regexp)))
(error (substitute-command-keys "(hyrolo-previous-match): Use {\\[hyrolo-grep-or-fgrep]} to do an initial search"))))
(defun hyrolo-prompt (keyboard-function prompt)
"Use KEYBOARD-FUNCTION to PROMPT for a yes/no answer."
(funcall keyboard-function prompt))
(defun hyrolo-quit ()
"Quit from the rolo match buffer and restore the prior frame display."
(interactive)
(hyrolo-verify)
(bury-buffer)
(and hyrolo--wconfig (window-configuration-p hyrolo--wconfig)
(set-window-configuration hyrolo--wconfig)))
(defun hyrolo-rename (old-file new-file)
"Prompt user to rename OLD-FILE to NEW-FILE."
(interactive (if hyperb:microsoft-os-p
'("c:/_rolo.otl" "~/.rolo.otl")
'("~/.rolodex.otl" "~/.rolo.otl")))
(if (and (equal (car hyrolo-file-list) new-file)
(file-readable-p old-file)
(progn (beep)
(or (hyrolo-prompt
'y-or-n-p
(format "(hyrolo-rename): Rename \"%s\" to the new standard \"%s\"? "
old-file new-file))
;; Setup to get rolo matches from OLD-FILE.
(progn (setq hyrolo-file-list
(cons old-file (cdr hyrolo-file-list)))
nil))))
(progn (rename-file old-file new-file 1)
;; Also rename backup file if it exists.
(when (file-readable-p (concat old-file "~"))
(rename-file (concat old-file "~") (concat new-file "~") 1))
(when (get-file-buffer old-file)
(with-current-buffer (get-file-buffer old-file)
(rename-buffer (file-name-nondirectory new-file))
(setq buffer-file-name (expand-file-name new-file))))
(message "(HyRolo): Your personal rolo file is now: \"%s\"."
new-file))))
(defun hyrolo-set-display-buffer ()
(prog1 (set-buffer (get-buffer-create hyrolo-display-buffer))
(unless (eq major-mode 'hyrolo-mode)
(hyrolo-mode))
(setq buffer-read-only nil)))
;;;###autoload
(defun hyrolo-sort (&optional hyrolo-file)
"Sort up to 14 levels of entries in HYROLO-FILE (default is personal rolo).
Assume entries are delimited by one or more `*' characters.
Return list of number of groupings at each entry level."
(interactive
(list (let ((default "")
(file))
(setq file
(completing-read
(format "Sort rolo file (default %s): "
(file-name-nondirectory
(setq default
(if (and buffer-file-name
(memq
t (mapcar
(lambda (file)
(equal buffer-file-name
(expand-file-name file)))
hyrolo-file-list)))
buffer-file-name
(car hyrolo-file-list)))))
(mapcar #'list hyrolo-file-list)))
(if (string-equal file "") default file))))
(when (or (not hyrolo-file) (equal hyrolo-file ""))
(setq hyrolo-file (car hyrolo-file-list)))
(unless (and (stringp hyrolo-file) (file-readable-p hyrolo-file))
(error "(hyrolo-sort): Invalid or unreadable file: %s" hyrolo-file))
(let ((level-regexp (regexp-quote "**************"))
(entries-per-level-list)
(n))
(while (not (string-empty-p level-regexp))
(setq n (hyrolo-sort-level hyrolo-file level-regexp))
(when (or (/= n 0) entries-per-level-list)
(setq entries-per-level-list (cons (list (/ (length level-regexp) 2) n)
entries-per-level-list)))
;; Subtract 2 here because there are two chars per star when
;; regexp-quoted: \\*
(setq level-regexp (substring level-regexp 0 (- (length level-regexp) 2))))
(goto-char (point-min))
(hyrolo-kill-buffer (current-buffer))
entries-per-level-list))
(defun hyrolo-sort-level (hyrolo-file level-regexp &optional max-groupings)
"Sort groupings of entries in HYROLO-FILE at hierarchy level LEVEL-REGEXP.
To a maximum of optional MAX-GROUPINGS. Nil value of MAX-GROUPINGS means all
groupings at the given level. LEVEL-REGEXP should simply match the text of
any rolo entry of the given level, not the beginning of a line (^); an
example, might be (regexp-quote \"**\") to match level two. Return number
of groupings sorted."
(interactive "sSort rolo file: \nRegexp for level's entries: \nP")
(outline-hide-sublevels (/ (length level-regexp) 2))
(let ((sort-fold-case t))
(hyrolo-map-level
(lambda (start end) (hyrolo-sort-lines nil start end))
hyrolo-file
level-regexp
max-groupings)))
;; This wraps forward-visible-line, making its ARG optional, making
;; its calling convention match that of forward-line.
;; Derived from `sort-lines' in "sort.el" since through at least Emacs 25.0
;; invisible lines are not grouped with the prior visible line, making
;; rolo entry (or any record) sorts fail. This next function fixes that.
;; Only the last line changes from the original `sort-lines' function.
(defun hyrolo-sort-lines (reverse beg end)
"Sort lines in region alphabetically; REVERSE non-nil means descending order.
Interactively, REVERSE is the prefix argument, and BEG and END are the region.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order."
(interactive "P\nr")
(save-excursion
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
;; To make `end-of-line', etc. ignore fields
(let ((inhibit-field-text-motion t))
(sort-subr reverse #'hyrolo-forward-visible-line #'end-of-visible-line)))))
;;;###autoload
(defun hyrolo-toggle-datestamps (&optional arg)
"Toggle whether datestamps are updated when rolo entries are modified.
With optional ARG, turn them on iff ARG is positive."
(interactive "P")
(if (or (and arg (<= (prefix-numeric-value arg) 0))
(and (not (and arg (> (prefix-numeric-value arg) 0)))
(boundp 'hyrolo-add-hook) (listp hyrolo-add-hook)
(memq 'hyrolo-set-date hyrolo-add-hook)))
(progn (remove-hook 'hyrolo-add-hook 'hyrolo-set-date)
(remove-hook 'hyrolo-edit-hook 'hyrolo-set-date)
(message "Rolo date stamps are now off."))
(add-hook 'hyrolo-add-hook #'hyrolo-set-date)
(add-hook 'hyrolo-edit-hook #'hyrolo-set-date)
(message "Rolo date stamps are now on.")))
(defun hyrolo-toggle-narrow-to-entry ()
"Toggle between display of current entry and display of all matched entries.
Useful when bound to a mouse key."
(interactive)
(if (buffer-narrowed-p)
(hyrolo-widen)
(let (case-fold-search)
(when (or (looking-at hyrolo-entry-regexp)
(re-search-backward hyrolo-entry-regexp nil t))
(forward-char)
(narrow-to-region (1- (point)) (hyrolo-display-to-entry-end)))))
(hyrolo-shrink-window)
(goto-char (point-min)))
(defun hyrolo-top-level ()
"Show only the first line of all top-level hyrolo matches.
Top-level matches are those with the lowest outline level among the
matched entries."
(interactive)
(hyrolo-verify)
(hyrolo-hide-subtree)
(hyrolo-show-levels 1))
(defun hyrolo-widen ()
"Widen non-special HyRolo buffers mainly for adding entries or editing them."
(unless (eq (get major-mode 'mode-class) 'special)
(widen)))
;;;###autoload
(defun hyrolo-word (string &optional max-matches hyrolo-file count-only headline-only no-display)
"Display rolo entries with whole word match for STRING.
To a maximum of optional prefix arg MAX-MATCHES, in file(s) from optional
HYROLO-FILE or hyrolo-file-list. Default is to find all matching entries. Each
entry is displayed with all of its sub-entries. Optional COUNT-ONLY
non-nil skips retrieval of matching entries. Optional HEADLINE-ONLY searches
only the first line of entries, not the full text. Optional NO-DISPLAY non-nil
retrieves entries but does not display them.
Nil value of MAX-MATCHES means find all matches, t value means find all matches
but omit file headers, negative values mean find up to the inverse of that
number of entries and omit file headers.
Return number of entries matched. See also documentation for the variable
hyrolo-file-list."
(interactive "sFind rolo whole word matches of: \nP")
(let ((total-matches (hyrolo-grep (format "\\b%s\\b" (regexp-quote string))
max-matches
hyrolo-file count-only headline-only no-display)))
(when (called-interactively-p 'interactive)
(message "%s matching entr%s found in the rolo."
(if (= total-matches 0) "No" total-matches)
(if (= total-matches 1) "y" "ies")))
total-matches))
;;;###autoload
(defun hyrolo-yank (name &optional regexp-p)
"Insert at point the first rolo entry matching NAME.
With optional prefix arg, REGEXP-P, treats NAME as a regular expression instead
of a string."
(interactive "sInsert rolo entry named: \nP")
(let ((hyrolo-display-buffer (current-buffer))
(start (point))
found)
(save-excursion
(setq found (if regexp-p
(hyrolo-grep name -1)
(hyrolo-grep (regexp-quote name) -1))))
;; Let user reformat the region just yanked.
(if (and (= found 1) (fboundp hyrolo-yank-reformat-function))
(funcall hyrolo-yank-reformat-function start (point)))
found))
;;; ************************************************************************
;;; Big Brother Database (BBDB) Integration
;;; ************************************************************************
;;;###autoload
(defun hyrolo-bbdb-fgrep (&optional arg)
"Fgrep over a bbdb database and format the results as rolo entries.
With optional prefix ARG, do a grep regexp match instead of a string match."
(interactive "P")
(hyrolo-bbdb-grep (not arg)))
;;;###autoload
(defun hyrolo-bbdb-grep (&optional arg)
"Grep over a bbdb database and format the results as rolo entries.
With optional prefix ARG, do an fgrep string match instead of a regexp match.
Output looks like so:
======================================================================
@loc> \".bbdb\"
======================================================================
* Jones Tom <[email protected]>