-
Notifications
You must be signed in to change notification settings - Fork 10
/
hui-select.el
1606 lines (1510 loc) · 60.4 KB
/
hui-select.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
;;; hui-select.el --- Select larger and larger syntax-driven regions in a buffer. -*- lexical-binding: t; -*-
;;
;; Author: Bob Weiner
;;
;; Orig-Date: 19-Oct-96 at 02:25:27
;; Last-Mod: 20-Apr-24 at 12:02:16 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of GNU Hyperbole.
;;; Commentary:
;;
;; This is a radically cool, drop in mouse and keyboard-based library for
;; selecting successively bigger syntactical regions within a buffer.
;; Simply load this library and you are ready to try it out by
;; double-clicking on various kinds of characters in different buffer major
;; modes. You'll quickly get the hang of it. (It also provides a command
;; to jump between beginning and end tags within HTML, SGML and XML buffers.)
;;
;; A great deal of smarts are built-in so that it does the right thing
;; almost all of the time; many other attempts at similar behavior such as
;; thing.el fail to deal with many file format complexities.
;;
;; Double clicks of the Selection Key (left mouse key) at the same point
;; will select bigger and bigger regions with each successive use. The
;; first double click selects a region based upon the character at the
;; point of the click. For example, with the point over an opening or
;; closing grouping character, such as { or }, the whole grouping is
;; selected, e.g. a C function. When on an _ or - within a programming
;; language variable name, the whole name is selected. The type of
;; selection is displayed in the minibuffer as feedback. When using a
;; language based mainly on indenting, like Bourne shell, a double click on
;; the first alpha character of a line, such as an if statement, selects
;; the whole statement.
;;
;; ---------------
;;
;; This whole package is driven by a single function, available in mouse
;; and keyboard forms, that first marks a region based on the syntax
;; category of the character following point. Successive invocations mark
;; larger and larger regions until the whole buffer is marked. See the
;; documentation for the function, `hui-select-syntactical-region', for the
;; kinds of syntax categories handled.
;;
;; Running the command, `hui-select-initialize', will install the
;; capabilities of this package and make double or triple clicks of
;; the left mouse key select bigger and bigger syntactic regions.
;; (See the documentation of the variable, `hui-select-thing-with-mouse',
;; for how this is done).
;;
;; The command, `hui-select-thing', may be bound to a key to provide the same
;; syntax-driven region selection functionality. {C-c RETURN} is a
;; reasonable site-wide choice since this key is seldom used and it
;; mnemonically indicates marking something; Hyperbole typically
;; binds this key for you. {C-c s} may be preferred as a personal binding.
;;
;; Use {C-g} to unmark the region when done. Use,
;; `hui-select-thing-with-mouse', if you want to bind this to a
;; different mouse key to use single clicks instead of double clicks.
;;
;; Four other commands are also provided:
;; `hui-select-and-copy-thing' - mark and copy the syntactical unit to the
;; kill ring
;; `hui-select-and-kill-thing' - kill the syntactical unit at point
;; `hui-select-goto-matching-tag' - In modes listed in the variable,
;; `hui-select-markup-modes'), move point to the
;; start of the tag paired with the closest tag that point is within or
;; which it precedes, so you can quickly jump back and forth between
;; open and close tags. In these modes, this is bound to {C-c .}
;; `hui-select-at-p' - predicate to test if a buffer position (or point) starts
;; or ends a matching syntactical region (excluding a single character).
;;
;; ---------------
;; SETUP IF USED SEPARATELY FROM HYPERBOLE (otherwise ignore):
;;
;; To autoload this package via mouse usage add the following line
;; to one of your initialization files.
;;
;; (hui-select-initialize)
;;
;; This will autoload this package, bind the selection command to a double
;; click of the left mouse button and set up Java, C++ and `hui-select-markup-modes'
;; for proper entity selection.
;;
;; For any version of Emacs you should add the following autoload entries
;; at your site if the auto-autoloads.el file in this directory will
;; not be loaded:
;;
;; (autoload 'hui-select-and-kill-thing
;; "hui-select" "Kill syntactical region selection" t)
;; (autoload 'hui-select-and-copy-thing
;; "hui-select" "Select and copy syntactical region" t)
;; (autoload 'hui-select-double-click-hook
;; "hui-select" "Double mouse click syntactical region selection" nil)
;; (autoload 'hui-select-thing
;; "hui-select" "Keyboard-driven syntactical region selection" t)
;; (autoload 'hui-select-thing-with-mouse
;; "hui-select" "Single mouse click syntactical region selection" t)
;;
;;; Code:
;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************
(require 'hvar)
(eval-when-compile
(require 'mhtml-mode) ;; for MHTML and HTML modes
(require 'sgml-mode) ;; for SGML mode
(require 'nxml-mode) ;; for XML mode
(require 'web-mode nil t))
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
(defcustom hui-select-brace-modes
'(c++-mode c-mode java-mode objc-mode perl-mode tcl-mode)
"*List of language major modes which define things with brace delimiters."
:type '(repeat (function :tag "Mode"))
:group 'hyperbole-commands)
(defcustom hui-select-markup-modes
'(html-mode mhtml-mode nxml-mode sgml-mode web-mode)
"*List of markup language modes that use SGML-style <tag> </tag> pairs."
:type '(repeat (function :tag "Mode"))
:group 'hyperbole-commands)
(defcustom hui-select-text-modes
'(fundamental-mode kotl-mode indented-text-mode Info-mode outline-mode text-mode)
"*List of textual modes where paragraphs may be outdented or indented."
:type '(repeat (function :tag "Mode"))
:group 'hyperbole-commands)
(defcustom hui-select-indent-modes
(append '(altmath-mode asm-mode csh-mode eiffel-mode ksh-mode
math-mode miranda-mode python-mode pascal-mode sather-mode)
hui-select-text-modes)
"*List of modes that use indentation mostly to define syntactic structure.
Use for language major modes."
:type '(repeat (function :tag "Mode"))
:group 'hyperbole-commands)
(defcustom hui-select-ignore-quoted-sexp-modes
'(debugger-mode emacs-lisp-mode lisp-mode lisp-interaction-mode slime-mode cider-mode)
"*List of modes in which to ignore quoted sexpressions for syntactic matches.
Use for language major modes."
:type '(repeat (function :tag "Mode"))
:group 'hyperbole-commands)
(defvar hui-select-indent-non-end-regexp-alist
'((altmath-mode "[^ \t\n]\\|[ \t\n]*\n\\s-")
(csh-mode "\\(\\|then\\|elsif\\|else\\)[ \t]*$")
(eiffel-mode "\\(\\|then\\|else if\\|else\\)[ \t]*$")
(ksh-mode "\\(\\|then\\|elif\\|else\\)[ \t]*$")
(math-mode "[^ \t\n]\\|[ \t\n]*\n\\s-")
(miranda-mode "[ \t>]*$")
(pascal-mode "\\(\\|then\\|else\\)[ \t]*$")
(python-mode "[ \t]*$")
(sather-mode "\\(\\|then\\|else if\\|else\\)[ \t]*$")
;;
(fundamental-mode "[^ \t\n*]")
(kotl-mode "[^ \t\n*]")
(indented-text-mode "[^ \t\n*]")
(Info-mode "[^ \t\n]")
(outline-mode "[^*]")
(text-mode "[^ \t\n*]"))
"List of (MAJOR-MODE . NON-TERMINATOR-LINE-REGEXP) elements.
Used to avoid early dropoff when marking indented code.")
(defvar hui-select-indent-end-regexp-alist
'((altmath-mode "[ \t\n]*\n\\S-")
(csh-mode "end\\|while")
(eiffel-mode "end")
(ksh-mode "\\(fi\\|esac\\|until\\|done\\)[ \t\n]")
(math-mode "[ \t\n]*\n\\S-")
(pascal-mode "end")
(sather-mode "end")
;;
(fundamental-mode "[ \t]*$")
(indented-text-mode "[ \t]*$")
(Info-mode "[ \t]*$")
(text-mode "[ \t]*$"))
"List of (MAJOR-MODE . TERMINATOR-LINE-REGEXP) elements.
Used to include a final line when marking indented code.")
(defcustom hui-select-char-p nil
"*If t, return single character boundaries when all else fails."
:type 'boolean
:group 'hyperbole-commands)
(defcustom hui-select-display-type t
"*If t, display the thing selected with each mouse click."
:type 'boolean
:group 'hyperbole-commands)
(defcustom hui-select-whitespace t
"*If t, groups of whitespace are considered as things."
:type 'boolean
:group 'hyperbole-commands)
(defconst hui-c++-defun-prompt-regexp
(let* ((space* "[ \t\n\r\f]*")
(space+ "[ \t\n\r\f]+")
(ad-hoc-requires-clause
(concat "\\(?:requires" space* "[][()<> \t\n\r\f_$a-zA-Z0-9&|\"'+=.,*:~-]+" space* "\\)?"))
(id (concat "[_$~a-zA-Z][_$a-zA-Z0-9]*")
;; (concat "\\(\\(~" space* "\\)?" "\\([_$a-zA-Z][_$a-zA-Z0-9]*\\)\\)")
)
(template-brackets "\\(?:<[^;{}]*>\\)")
(id-<> (concat id "\\(?:" space* template-brackets "\\)?"))
(id-:: (concat id-<> "\\(?:" space* "::" space* id-<> "\\)*"))
(paren-exp "([^{};]*)")
(template-exp\? (concat "\\(?:template" space* template-brackets space* "\\)?"))
(type-prefix-modifier* (concat "\\(?:\\(?:"
"\\(?:\\<extern" space+ "\"[^\"]+\"\\)"
"\\|"
(regexp-opt '("auto" "const" "explicit" "extern"
"friend" "inline" "mutable"
"noexcept" "overload"
"register" "static" "typedef"
"virtual" "volatile")
'words)
"\\)"
space+
"\\)*"))
(type-exp (concat
"\\(?:\\(?:" template-brackets space* "\\)?"
type-prefix-modifier*
"\\(?:\\(?:decltype" space* paren-exp space* "\\)"
"\\|"
"\\(?:"
"\\(?:class\\|enum\\|struct\\|typename\\|union\\)"
"\\(?:" space* "\\.\\.\\.\\)?\\)"
space+ id space*
"\\(?::" id-:: space* "\\)?"
"\\|"
id-:: space*
"\\)"
"\\)\\{1,2\\}"))
(type-mid-modifier* (concat "\\(?:"
(regexp-opt
'("auto" "consteval" "constexpr"
"constinit" "explicit"
"extern" "friend" "inline"
"mutable" "noexcept" "register"
"static" "template"
"thread_local" "throw"
"virtual" "volatile")
'words)
space+ "\\)*"))
(operator-exp (concat "\\(?:operator\\>" space*
"\\(?:[][a-z_+*/%^?&|!~<>,:=-]+"
"\\|()\\|\"\""
"\\)" space*
"\\)"))
(name-exp ; matches foo or (* foo), etc.
(concat "\\(?:(" space* "[*&]+" space* id-:: space* "[][()]*" ")"
"\\|\\(?:[*&]+" space* "\\)?" id-::
"\\)" space*))
(type-suffix-modifier* (concat "\\(?:"
(regexp-opt
'("auto" "const" "noexcept"
"requires" "throw" "volatile")
'words)
space+ "\\)*"))
(post-paren-modifier* (concat "\\(?:"
(regexp-opt
'("const" "final" "override"
"mutable")
'words)
space* "\\)*")))
(concat template-exp\?
"\\(?:" ad-hoc-requires-clause "\\)?"
type-exp
type-mid-modifier*
"\\(?:" operator-exp "\\|" name-exp "\\)"
type-suffix-modifier*
paren-exp space*
"\\(?:->" space* type-exp "\\)?"
post-paren-modifier*
"{")))
(defconst hui-java-defun-prompt-regexp
(let* ((space* "[ \t\n\r\f]*")
(space+ "[ \t\n\r\f]+")
(modifier*
(concat "\\(?:"
(regexp-opt '("abstract" "const" "default" "final" "native"
"private" "protected" "public" "static"
"strictfp" "synchronized" "threadsafe"
"transient" "volatile")
'words) ; Compatible with XEmacs
space+ "\\)*"))
(ids-with-dots "[_$a-zA-Z][_$.a-zA-Z0-9]*")
(ids-with-dot-\[\] "[[_$a-zA-Z][][_$.a-zA-Z0-9]*")
(paren-exp "([^);{}]*)")
(generic-exp "<[^(){};]*>"))
(concat "^[ \t]*"
modifier*
"\\(?:" generic-exp space* "\\)?"
ids-with-dot-\[\] space+ ; first part of type
"\\(?:" ids-with-dot-\[\] space+ "\\)?" ; optional second part of type.
"\\(?:[_a-zA-Z][^][ \t:;.,{}()=<>]*" ; defun name
"\\|" ids-with-dots
"\\)" space*
paren-exp
"\\(?:" space* "]\\)*" ; What's this for?
"\\(?:" space* "\\<throws\\>" space* ids-with-dot-\[\]
"\\(?:," space* ids-with-dot-\[\] "\\)*"
"\\)?"
space*)))
(defvar hui-select-previous nil)
(defvar hui-select-prior-point nil)
(defvar hui-select-prior-buffer nil)
;;; ************************************************************************
;;; Public declarations
;;; ************************************************************************
(defvar help-mode-syntax-table) ; "help-mode.el"
(defvar hkey-init) ; "hyperbole.el"
(defvar hkey-value) ; "hui-mouse.el"
(defvar hyperbole-mode-map) ; "hyperbole.el"
(defvar org-mode-map) ; "org.el"
(declare-function kview:valid-position-p "kotl/kview")
(declare-function hkey-set-key "hyperbole")
(declare-function hypb:cmd-key-vector "hypb")
;;; ************************************************************************
;;; Private variables
;;; ************************************************************************
(defconst hui-select-syntax-table
(let ((st (copy-syntax-table emacs-lisp-mode-syntax-table)))
;; Make braces be thing delimiters, not punctuation.
(modify-syntax-entry ?\{ "(}" st)
(modify-syntax-entry ?\} "){" st)
(modify-syntax-entry ?< "(>" st)
(modify-syntax-entry ?> ")<" st)
st)
"Syntax table to use when selecting delimited things.")
(defvar hui-select-bigger-alist
'((char nil)
(whitespace hui-select-whitespace)
(word hui-select-word)
(symbol hui-select-symbol)
(punctuation nil)
(string hui-select-string)
(text nil)
(comment hui-select-comment)
(markup-pair nil)
(preprocessor-def nil)
(sexp hui-select-sexp)
(sexp-start nil)
(sexp-end nil)
(sexp-up hui-select-sexp-up)
(line hui-select-line)
(sentence hui-select-sentence)
(brace-def-or-declaration hui-select-brace-def-or-declaration)
(indent-def hui-select-indent-def)
(paragraph hui-select-paragraph)
(page hui-select-page)
(buffer hui-select-buffer))
"Unordered list of (<region-type-symbol> <region-selection-function>) pairs.
Used to go from one thing to a bigger thing. See `hui-select-bigger-thing'.
Nil value for <region-selection-function> means that region type is skipped
over when trying to grow the region and is only used when a selection is made
with point on a character that triggers that type of selection.")
(defvar hui-select-prior-buffer nil)
(defvar hui-select-prior-point nil)
(defvar hui-select-previous 'char
"Most recent type of selection. Must be set by all hui-select functions.")
(defvar hui-select-region (cons nil nil)
"Cons cell that contains a region (<beginning> . <end>).
The function `hui-select-set-region' updates and returns it.")
(defvar hui-select-old-region (cons nil nil)
"Cons cell that contains a region (<beginning> . <end>).")
(defcustom hui-select-syntax-alist
'((?w . hui-select-word)
(?_ . hui-select-symbol)
(?\" . hui-select-string)
(?\( . hui-select-sexp-start)
(?\$ . hui-select-sexp-start)
(?\' . hui-select-sexp-start)
(?\) . hui-select-sexp-end)
(? . hui-select-whitespace)
(?\< . hui-select-comment)
(?\. . hui-select-punctuation))
"*Unordered list of pairs of the form (<syntax-char> <function>).
Used by the function `hui-select-syntactical-region'.
Each <function> takes a single position argument and returns a
region (start . end) defining the boundaries of the thing at that position."
:type '(repeat (cons (character :tag "Syntax-Char") function))
:group 'hyperbole-commands)
;;; ************************************************************************
;;; Public functions
;;; ************************************************************************
;;
;; Commands
;;
;;;###autoload
(defun hui-select-at-p (&optional pos)
"Non-nil means character matches a syntax entry in `hui-select-syntax-alist'.
The character is after optional POS or point. The non-nil value
returned is the function to call to select that syntactic unit."
(interactive "d")
(unless (smart-eobp)
(or (numberp pos) (setq pos (point)))
(setq hui-select-previous 'char)
(let* ((syntax (char-syntax (or (char-after pos) (char-before pos))))
(pair (assq syntax hui-select-syntax-alist)))
(and pair (or hui-select-whitespace (not (eq (cdr pair) 'thing-whitespace)))
;; Ignore matches that are preceded by '\' as a quote, e.g. ?\'
(or (not (char-after pos))
(= pos (point-min))
(and (char-before pos) (/= ?\\ (char-before pos))))
(cdr pair)))))
;;;###autoload
(defun hui-select-goto-matching-delimiter ()
"Jump back and forth between the start and end delimiters of a thing.
If the key that invokes this command in `hyperbole-minor-mode' is
also bound in the current major mode map, then interactively
invoke that command instead. Typically prevents clashes over
{\\`C-c' .}."
(interactive)
(if (memq major-mode hui-select-markup-modes)
(hui-select-goto-matching-tag)
(let* ((key (hypb:cmd-key-vector #'hui-select-goto-matching-delimiter
hyperbole-mode-map))
(major-mode-binding (lookup-key (current-local-map) key))
(this-key-flag (and (called-interactively-p 'any)
(equal (this-single-command-keys) key))))
(cond ((and major-mode-binding (not (integerp major-mode-binding))
this-key-flag)
;; If the key that invokes this command in `hyperbole-minor-mode'
;; is also bound in the current major mode map, then
;; interactively invoke that command instead. Typically
;; prevents clashes over {C-c .}.
(call-interactively major-mode-binding))
((and (preceding-char) (or (= ?\) (char-syntax (preceding-char)))
(= ?\" (preceding-char))))
(backward-sexp))
((and (following-char) (or (= ?\( (char-syntax (following-char)))
(= ?\" (following-char))))
(forward-sexp))))))
;;;###autoload
(defun hui-select-initialize ()
"Initialize the hui-select mode on a double click of the left mouse key.
Also, add language-specific syntax setups to aid in thing selection."
(interactive)
(unless (boundp 'hyperbole-loading)
(require 'hyperbole))
(when hkey-init
(transient-mark-mode 1)
(hkey-set-key [double-down-mouse-1] nil)
(hkey-set-key [double-mouse-1] 'hui-select-thing-with-mouse)
(hkey-set-key [triple-down-mouse-1] nil)
(hkey-set-key [triple-mouse-1] 'hui-select-thing-with-mouse))
;;
;; These hooks let you select C++ and Java methods and classes by
;; double-clicking on the first character of a definition or on its
;; opening or closing brace. This is all necessary since some
;; programmers don't put their function braces in the first column.
(var:add-and-run-hook 'java-mode-hook (lambda ()
(setq defun-prompt-regexp hui-java-defun-prompt-regexp)))
(var:add-and-run-hook 'c++-mode-hook (lambda ()
(setq defun-prompt-regexp hui-c++-defun-prompt-regexp)))
;;
;; Match to Lisp symbols with : in their names, often included in help buffers.
(var:add-and-run-hook 'help-mode-hook (lambda () (modify-syntax-entry ?: "_" help-mode-syntax-table)))
;;
;; Allow for marking and moving brace delimited groups.
(var:add-and-run-hook 'lisp-mode-hook
(lambda ()
(modify-syntax-entry ?\{ "(}" lisp-mode-syntax-table)
(modify-syntax-entry ?\} "){" lisp-mode-syntax-table)))
;;
;; This hook makes tags, comments, sentences and text blocks
;; selectable in SGML-related modes.
;;
;; Make tag begin and end delimiters act like grouping characters,
;; for easy syntactical selection of tags.
(let (hook-sym
mode-str
syntax-table-sym
keymap-sym)
(mapc (lambda (mode)
(setq mode-str (symbol-name mode)
hook-sym (intern (concat mode-str "-hook"))
syntax-table-sym (intern (concat mode-str "-syntax-table"))
keymap-sym (intern (concat mode-str "-map")))
(var:add-and-run-hook hook-sym
`(lambda ()
(let ((syntax-table (symbol-value ',syntax-table-sym))
(keymap (symbol-value ',keymap-sym)))
;; (modify-syntax-entry ?\< "(>" syntax-table)
;; (modify-syntax-entry ?\> ")<" syntax-table)
(modify-syntax-entry ?\{ "(}" syntax-table)
(modify-syntax-entry ?\} "){" syntax-table)
(modify-syntax-entry ?\" "\"" syntax-table)
(modify-syntax-entry ?= "." syntax-table)
(modify-syntax-entry ?. "_" syntax-table)
(setq sentence-end "\\([^ \t\n\r>]<\\|>\\(<[^>]*>\\)*\\|[.?!][]\"')}]*\\($\\| $\\|\t\\| \\)\\)[ \t\n]*")
(define-key keymap "\C-c." 'hui-select-goto-matching-tag))))
(unless (eq mode 'web-mode)
(var:add-and-run-hook
hook-sym (lambda ()
(make-local-variable 'comment-start)
(make-local-variable 'comment-end)
(setq comment-start "<!--" comment-end "-->")
(make-local-variable 'sentence-end)))))
hui-select-markup-modes)))
(defun hui-select-get-region-boundaries ()
"Return the (START . END) boundaries of region for `hui-select-thing'."
(or (hui-select-boundaries (point))
(when (eq hui-select-previous 'punctuation)
(hui-select-word (point)))))
;;;###autoload
(defun hui-select-get-thing ()
"Return the thing at point that `hui-select-thing' would select."
(let ((region-bounds (hui-select-get-region-boundaries)))
(when region-bounds
(buffer-substring-no-properties (car region-bounds) (cdr region-bounds)))))
(defun hui-select-scan-sexps (from count)
"Scan FROM point across COUNT sexpressions."
(if (memq major-mode hui-select-ignore-quoted-sexp-modes)
(scan-sexps from count)
(with-syntax-table hui-select-syntax-table
(scan-sexps from count))))
;;;###autoload
(defun hui-select-thing ()
"Select a region based on the syntax of the thing at point.
If invoked repeatedly, this selects bigger and bigger things.
If `hui-select-display-type' is non-nil and this is called
interactively, the type of selection is displayed in the minibuffer.
If the key that invokes this command in `hyperbole-minor-mode' is
also bound in the current major mode map, then interactively
invoke that command instead. Typically prevents clashes over
{\\`C-c' RET}, {\\`C-c´ \\`C-m'}."
(interactive
(cond ((and (fboundp 'use-region-p) (use-region-p))
nil)
((and transient-mark-mode mark-active)
nil)
(t
;; Reset selection based on the syntax of character at point.
(hui-select-reset)
nil)))
(let* ((key (hypb:cmd-key-vector #'hui-select-thing hyperbole-mode-map))
(major-mode-binding (lookup-key (current-local-map) key))
(this-key-flag (and (called-interactively-p 'any)
(equal (this-single-command-keys) key))))
(cond ((and major-mode-binding (not (integerp major-mode-binding))
this-key-flag)
;; If the key that invokes this command in `hyperbole-minor-mode'
;; is also bound in the current major mode map, then
;; interactively invoke that command instead. Typically
;; prevents clashes over {C-c RET}, {C-c C-m}.
(call-interactively major-mode-binding))
;;
;; No key conflicts, perform normal Hyperbole operation
(t (let ((region (hui-select-get-region-boundaries)))
(unless region
(when (eq hui-select-previous 'punctuation)
(setq region (hui-select-word (point)))))
(when region
(goto-char (car region))
(set-mark (cdr region))
(when transient-mark-mode
(activate-mark))
(and (called-interactively-p 'interactive) hui-select-display-type
(message "%s" hui-select-previous))
(run-hooks 'hui-select-thing-hook)
t))))))
;;;###autoload
(defun hui-select-thing-with-mouse (event)
"Select a region based on the syntax of the character from a mouse click EVENT.
If the click occurs at the same point as the last click, select
the next larger syntactic structure. If `hui-select-display-type' is
non-nil and this is called interactively, the type of selection is
displayed in the minibuffer."
(interactive "@e")
(mouse-set-point event)
(cond ((and (eq hui-select-prior-point (point))
(eq hui-select-prior-buffer (current-buffer)))
;; Prior click was at the same point as before, so enlarge
;; selection to the next bigger item.
(let ((select-active-regions t)) ;; Automatically copy active
;; region to PRIMARY inter-program selection.
(when (hui-select-bigger-thing)
(and (called-interactively-p 'interactive) hui-select-display-type
(message "%s" hui-select-previous))))
t)
(t (setq this-command 'mouse-start-selection)
(hui-select-reset)
(hui-select-thing-with-mouse event))))
;;;###autoload
(defun hui-select-goto-matching-tag ()
"Move point to start of the tag paired with closest tag point is at or precedes.
Tag in this context is an sgml-like tag surrounded by angle brackets, <>.
Enabled in major modes contained in the list, `hui-select-markup-modes'.
Return t if point is moved, else nil. Signal an error if no tag is found
following point or if the closing tag does not have a `>' terminator character."
(interactive)
(when (memq major-mode hui-select-markup-modes)
(let ((result)
;; Assume case of tag names is irrelevant.
(case-fold-search t)
(opoint (point))
(tag)
end-point
start-regexp
end-regexp)
;; Leave point at the start of the tag that point is within or that
;; follows point.
(cond
;; Point is at the start of a tag.
((looking-at "<[^<> \t\n\r]"))
;; Point was within a tag.
((and (re-search-backward "[<>]" nil t)
(looking-at "<[^<> \t\n\r]")))
;; Move to following tag.
((and (re-search-forward "<" nil t)
(progn (backward-char 1)
(looking-at "<[^<> \t\n\r]"))))
;; No tag follows point.
(t (error "(hui-select-goto-matching-tag): No tag found after point")))
(if (catch 'done
(cond
;; Beginning of a tag pair
((looking-at "<[^/][^<> \t\n\r]*")
(setq tag (match-string 0)
start-regexp (regexp-quote tag)
end-regexp (concat "</" (substring start-regexp 1)))
;; Skip over nested tags.
(let ((count 0)
(regexp (concat start-regexp "\\|" end-regexp))
match-point)
(while (and (>= count 0)
(re-search-forward regexp nil t))
(setq match-point (match-beginning 0))
(if (/= (char-after (1+ (match-beginning 0))) ?/)
;; Start tag
(setq count (1+ count))
;; End tag
(setq end-point (point))
(if (or (not (re-search-forward "[<>]" nil t))
(= (preceding-char) ?<))
;; No terminator character `>' for end tag
(progn (setq result end-point)
(throw 'done nil)))
(setq count (1- count))
(when (zerop count)
(goto-char match-point)
(setq result t)
(throw 'done result))))))
;;
;; End of a tag pair
((or (looking-at "</[^\> \t\n\r]+")
(and (skip-chars-backward "<")
(looking-at "</[^\> \t\n\r]+")))
(goto-char (match-end 0))
(setq tag (match-string 0)
end-regexp (regexp-quote tag)
start-regexp (concat "<" (substring end-regexp 2)))
(setq end-point (point))
(when (or (not (re-search-forward "[<>]" nil t))
(= (preceding-char) ?<))
;; No terminator character `>' for end tag
(setq result end-point)
(throw 'done nil))
;; Skip over nested tags.
(let ((count 0)
(regexp (concat start-regexp "\\|" end-regexp)))
(while (and (>= count 0)
(re-search-backward regexp nil t))
(if (= (char-after (1+ (point))) ?/)
;; End tag
(setq count (1+ count))
;; Start tag
(setq count (1- count))
(when (zerop count)
(setq result t)
(throw 'done t))))))))
nil
;; Didn't find matching tag.
(goto-char opoint))
(cond ((integerp result)
(goto-char result)
(error "(hui-select-goto-matching-tag): Add a terminator character for this end <tag>"))
((null tag)
(error "(hui-select-goto-matching-tag): No <tag> following point"))
((null result)
(when (called-interactively-p 'interactive)
(beep)
(message "(hui-select-goto-matching-tag): No matching tag for %s>" tag)
result))
(t result)))))
;;;###autoload
(defun hui-select-and-copy-thing ()
"Copy the region surrounding the syntactical unit at point to the kill ring."
(interactive)
(let ((bounds (hui-select-boundaries (point))))
(when bounds
(copy-region-as-kill (car bounds) (cdr bounds)))))
;;;###autoload
(defun hui-select-and-kill-thing ()
"Kill the region surrounding the syntactical unit at point."
(interactive "*")
(let ((bounds (hui-select-boundaries (point))))
(when bounds
(kill-region (car bounds) (cdr bounds)))))
;;
;; Functions
;;
(defun hui-select-boundaries (pos)
"Return the (start . end) of a syntactically defined region.
This is based upon the last region selected or on position POS.
The character at POS is selected if no other thing is matched."
(interactive)
(setcar hui-select-old-region (car hui-select-region))
(setcdr hui-select-old-region (cdr hui-select-region))
(let ((prior-type hui-select-previous))
(cond
((eq hui-select-previous 'char)
(hui-select-syntactical-region pos))
((and (car hui-select-old-region)
(memq hui-select-previous
'(sexp sexp-start sexp-end sexp-up))
(hui-select-sexp-up pos)
(hui-select-region-bigger-p hui-select-old-region hui-select-region))
hui-select-region)
;;
;; In the general case, we can't know ahead of time what the next
;; biggest type of thing to select is, so we test them all and choose
;; the best fit. This means that dynamically, the order of type
;; selection will change based on the buffer context.
(t (let ((min-region (1+ (- (point-max) (point-min))))
(result)
region region-size)
(mapc
(lambda (sym-func)
(setq region
(when (car (cdr sym-func))
(funcall (car (cdr sym-func)) pos)))
(when (and region (car region)
(hui-select-region-bigger-p
hui-select-old-region region)
(setq region-size
(- (cdr region) (car region)))
(< region-size min-region))
(setq min-region region-size
result
(list
;; The actual selection type is
;; sometimes different than the one we
;; originally tried, so recompute it here.
(car (assq hui-select-previous
hui-select-bigger-alist))
(car region) (cdr region)))))
hui-select-bigger-alist)
(if result
;; Returns hui-select-region
(progn (setq hui-select-previous (car result))
(hui-select-set-region (nth 1 result) (nth 2 result)))
;;
;; Restore prior selection type since we failed to find a
;; new one.
(setq hui-select-previous prior-type)
(beep)
(message
"(hui-select-boundaries): `%s' is the largest selectable region"
hui-select-previous)
nil))))))
;;;###autoload
(defun hui-select-double-click-hook (event click-count)
"Select region based on the character syntax where the mouse is double-clicked.
If the double-click EVENT occurs at the same point as the last
double-click, select the next larger syntactic structure. If
`hui-select-display-type' is non-nil, the type of selection is
displayed in the minibuffer."
(cond ((/= click-count 2)
;; Return nil so any other hooks are performed.
nil)
(t (hui-select-thing-with-mouse event))))
(defun hui-select-syntactical-region (pos)
"Return the (start . end) of a syntactically defined region based upon POS.
Uses `hui-select-syntax-alist' and the current buffer's syntax table to
determine syntax groups.
Typically:
Open or close grouping character syntax marks an s-expression.
Double quotes mark strings.
The end of a line marks the line, including its trailing newline.
Word syntax marks the current word.
Symbol syntax (such as _) marks a symbol.
Whitespace marks a span of whitespace.
Comment start or end syntax marks the comment.
Punctuation syntax marks the words on both sides of the punctuation.
If `hui-select-char-p' is set non-nil, then as a fallback, the
character at POS will be selected.
If an error occurs during syntax scanning, it returns nil."
(interactive "d")
(setq hui-select-previous 'char)
(if (save-excursion (goto-char pos) (eolp))
(hui-select-line pos)
(let* ((syntax (char-syntax (or (char-after pos) (char-before pos))))
(pair (assq syntax hui-select-syntax-alist)))
(cond ((and pair
(or hui-select-whitespace
(not (eq (cdr pair) 'hui-select-whitespace))))
(funcall (cdr pair) pos))
(hui-select-char-p
(setq hui-select-previous 'char)
(hui-select-set-region pos (1+ pos)))))))
(defun hui-select-at-delimited-thing-p ()
"Return non-nil if point is at a delimited thing, else nil.
A delimited tings is a markup pair, list, array/vector, set,
comment or string. The non-nil value returned is the function to
call to select that syntactic unit.
Ignores any match if on an Emacs button and instead returns nil."
(unless (button-at (point))
(setq hkey-value (hui-select-delimited-thing-call #'hui-select-at-p))
(cond ((eq hkey-value 'hui-select-punctuation)
(if (hui-select-comment (point))
(setq hkey-value #'hui-select-comment)
;; Else here used to be `hkey-value' but then we are returning a
;; value for any punctuation character without knowing if
;; it is part of a delimited thing. Nil should be the
;; right thing here.
nil))
(t hkey-value))))
(defun hui-select-delimited-thing ()
"Select a markup pair, list, array/vector, set, comment or string at point.
Return t if selected, else nil."
(interactive)
(prog1 (and (hui-select-delimited-thing-call #'hui-select-thing) t)
;; If selected region is followed by only whitespace and then a
;; newline, add the newline to the region.
(when (use-region-p)
(if (> (mark) (point))
(save-excursion
(goto-char (mark))
(skip-chars-forward " \t")
(and (char-after) (= ?\n (char-after))
(set-mark (1+ (point)))))
(when (looking-at "[ \t]*\n")
(goto-char (match-end 0)))))))
(defun hui-select-at-delimited-sexp-p ()
"Select a delimited sexp."
(unless (eolp)
(let ((syn-before (if (char-before) (char-syntax (char-before)) 0))
(syn-after (if (char-after) (char-syntax (char-after)) 0)))
(or (and (/= syn-before ?\\) (or (= syn-after ?\() (= syn-after ?\))))
(and (= syn-before ?\)) (char-before (1- (point)))
(/= ?\\ (char-syntax (char-before (1- (point))))))))))
(defun hui-select-mark-delimited-sexp ()
"When point is before or after an sexp deactivate the mark and mark the sexp.
Not enabled when point is at an end of line. Return t if marked,
nil otherwise. If any error occurs such as unbalanced start and
end sexp delimiters, ignore it, and return nil."
(interactive)
(let ((mark-sexp-func (lambda ()
(when (region-active-p) (deactivate-mark))
(mark-sexp) t)))
(ignore-errors
(let ((syn-after (char-syntax (char-after)))
syn-before)
(cond ((eq syn-after ?\()
(funcall mark-sexp-func))
((eq syn-after ?\))
(forward-char 1)
(backward-sexp)
(funcall mark-sexp-func))
((and (not (eolp))
(setq syn-before (char-syntax (char-before)))
(eq syn-before ?\)))
(backward-sexp)
(funcall mark-sexp-func)))))))
;;; ************************************************************************
;;; Private functions
;;; ************************************************************************
(defun hui-select-at-blank-line-or-comment ()
"Return non-nil if on a blank line or a comment start or end line.
Assume point is before any non-whitespace character on the line."
(let ((comment-end-p (and (stringp comment-end)
(not (string-equal comment-end "")))))
(if (looking-at
(concat "\\s-*$\\|\\s-*\\(//\\|/\\*\\|.*\\*/"
(if comment-start
(concat
"\\|" (regexp-quote comment-start)))
(if comment-end-p
(concat
"\\|.*" (regexp-quote comment-end)))
"\\)"))
(or (not (and comment-start comment-end-p))
;; Ignore start and end of comments that
;; follow non-commented text.
(not (looking-at
(format ".*\\S-.*%s.*%s"
(regexp-quote comment-start)
(regexp-quote comment-end))))))))
(defun hui-select-back-to-indentation ()
"Move point to the first non-whitespace character on this line and return point.
This respects the current syntax table definition of whitespace, whereas
`back-to-indentation' does not. This is relevant in literate programming and
mail and news reply modes."
(goto-char (min (line-end-position)
(progn (beginning-of-line)
(skip-syntax-forward " ")
(point)))))
(defun hui-select-bigger-thing ()
"Select a bigger object where point is."
(prog1
(call-interactively 'hui-select-thing)
(setq this-command 'select-thing)))
(defun hui-select-delimited-thing-call (func)
"Select a delimited thing at point and return a function to select it.
The delimited thing is a markup pair, list, vector/array, set,
comment or string. The non-nil value returned is the function to
call to select that syntactic unit."
(unless (and (memq major-mode hui-select-ignore-quoted-sexp-modes)
;; Ignore quoted identifier sexpressions, like #'function
(char-after) (memq (char-after) '(?# ?\')))
(let ((hui-select-char-p)
(hui-select-whitespace)
(hui-select-syntax-alist '((?\" . hui-select-string)
(?\( . hui-select-sexp-start)
(?\$ . hui-select-sexp-start)
(?\' . hui-select-sexp-start)
(?\) . hui-select-sexp-end)
(?\< . hui-select-comment)
;; Punctuation needed to match
;; multi-char comment delimiters
(?\. . hui-select-punctuation))))
(hui-select-reset)
(funcall func))))
(defun hui-select-region-bigger-p (old-region new-region)
"Non-nil means the new region is bigger than the old region.
Return t if OLD-REGION is smaller than NEW-REGION and NEW-REGION
partially overlaps OLD-REGION, or if OLD-REGION is uninitialized."
(if (null (car old-region))
t
(and (> (abs (- (cdr new-region) (car new-region)))
(abs (- (cdr old-region) (car old-region))))
;; Ensure the two regions intersect.
(or (and (<= (min (cdr new-region) (car new-region))