forked from rolandwalker/back-button
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathback-button.el
904 lines (784 loc) · 35.7 KB
/
back-button.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
;;; back-button.el --- Visual navigation through mark rings
;;
;; Copyright (c) 2012-2015 Roland Walker
;;
;; Author: Roland Walker <[email protected]>
;; Homepage: http://github.com/rolandwalker/back-button
;; URL: http://raw.githubusercontent.com/rolandwalker/back-button/master/back-button.el
;; Version: 0.6.8
;; Last-Updated: 4 Aug 2015
;; EmacsWiki: BackButton
;; Keywords: convenience, navigation, interface
;; Package-Requires: ((nav-flash "1.0.0") (smartrep "0.0.3") (list-utils "0.4.2") (persistent-soft "0.8.8") (pcache "0.2.3"))
;;
;; Simplified BSD License
;;
;;; Commentary:
;;
;; Quickstart
;;
;; (require 'back-button)
;;
;; (back-button-mode 1)
;;
;; press the plus sign in the toolbar to create a mark
;;
;; press the arrows in the toolbar to navigate marks
;;
;; or use C-x C-Space as usual, then try C-x C-<right>
;; to reverse the operation
;;
;; Explanation
;;
;; Back-button provides an alternative method for navigation by
;; analogy with the "back" button in a web browser.
;;
;; Every Emacs command which pushes the mark leaves behind an
;; invisible record of the location of the point at that moment.
;; Back-button moves the point back and forth over all the positions
;; where some command pushed the mark.
;;
;; This is essentially a replacement for `pop-global-mark', and the
;; default keybindings (when the minor mode is activated) override
;; that command. The differences with `pop-global-mark' are:
;;
;; - Visual index showing how far you have traveled in the
;; mark ring.
;;
;; - Easy way to move both forward and backward in the ring.
;;
;; - Pushes a mark on the first of a series of invocations, so you
;; can always return to where you issued the command.
;;
;; - Skips duplicate positions, so that the interactive command
;; always moves the point if possible.
;;
;; Commands and keybindings are also included to give identical
;; semantics for navigating the local (per-buffer) `mark-ring'. This
;; consistency in navigation comes at the cost of pushing the mark
;; twice, so experienced Emacs users may prefer to unbind these
;; commands and/or set `back-button-never-push-mark' in customize.
;;
;; To use back-button, place the back-button.el library somewhere
;; Emacs can find it, and add the following to your ~/.emacs file:
;;
;; (require 'back-button)
;; (back-button-mode 1)
;;
;; Default key bindings:
;;
;; C-x C-<SPC> go back in `global-mark-ring', respects prefix arg
;; C-x C-<left> go back in `global-mark-ring'
;; C-x C-<right> go forward in `global-mark-ring'
;;
;; C-x <SPC> go back in (buffer-local) `mark-ring', respects prefix arg
;; C-x <left> go back in (buffer-local) `mark-ring'
;; C-x <right> go forward in (buffer-local) `mark-ring'
;;
;; When the smartrep package is installed, the C-x prefix need not
;; be used for consecutive back-button commands.
;;
;; When the visible-mark package is installed, marks will be
;; made visible in the current buffer during navigation.
;;
;; See Also
;;
;; M-x customize-group RET back-button RET
;; M-x customize-group RET editing-basics RET
;; M-x customize-group RET visible-mark RET
;; M-x customize-group RET nav-flash RET
;;
;; Notes
;;
;; This library depends upon other commands pushing the mark to
;; provide useful waypoints for navigation. This is a common
;; convention, but not universal.
;;
;; The function `back-button-push-mark-local-and-global' may be
;; useful to call from Lisp. It is a replacement for `push-mark'
;; which unconditionally pushes onto the global mark ring,
;; functionality which is not possible using vanilla `push-mark'.
;;
;; Theoretically, `back-button-push-mark-local-and-global' could
;; cause issues with Lisp code which depends on the convention that
;; `global-mark-ring' not contain consecutive marks in the same
;; buffer. However, no such issues have been observed.
;;
;; Compatibility and Requirements
;;
;; GNU Emacs version 24.4-devel : yes, at the time of writing
;; GNU Emacs version 24.3 : yes
;; GNU Emacs version 23.3 : yes
;; GNU Emacs version 22.2 : yes, with some limitations
;; GNU Emacs version 21.x and lower : unknown
;;
;; Uses if present: smartrep.el, nav-flash.el, visible-mark.el,
;;
;; Bugs
;;
;; Pressing the toolbar back-button can navigate to a different
;; buffer with a different toolbar (and no back-button).
;;
;; Toolbar button disabling is not dependable. Logic is left
;; in place but unused.
;;
;; Toolbar shift-click does not work in Cocoa Emacs.
;;
;; Toolbar shift-click is not consistent with keyboard bindings
;; (control for global ring, unmodified for local ring)
;;
;; Displaying the index in a popup requires unreleased popup-volatile.el
;;
;; TODO
;;
;; better toolbar icons
;;
;; bug in visible-mark bug when mark is on last char of line
;;
;; integrated delete-mark
;;
;; could remove smartrep and implement mini-mode that includes
;; extra commands such as delete-mark and perhaps digits
;; for visible marks
;;
;; Used to remember thumb between series, so long as no mark was
;; pushed, now that does not work b/c these functions themselves
;; push the mark -- make that an option? Maybe the right way is
;; to keep it out-of-band.
;;
;; this is a crude but general way to force a navigation
;; command to push the mark:
;;
;; (defvar push-mark-before-goto-char nil)
;; (defadvice goto-char (before push-mark-first activate)
;; (when push-mark-before-goto-char
;; (back-button-push-mark-local-and-global nil t)))
;; ;; example use
;; (defun ido-imenu-push-mark ()
;; (interactive)
;; (let ((push-mark-before-goto-char t))
;; (ido-imenu)))
;;
;; A better way would be: using a pre-command-hook, track series of
;; related navigation commands (defined by a property placed on
;; each command). Push a global mark for the first of a related
;; series, don't push for subsequent. There is already a property
;; placed on some navigation commands which might be sufficient -
;; or is that only scroll commands? There is a package AutoMark
;; which purports to do this, but it doesn't do the hard part of
;; classifying all commands.
;;
;;; License
;;
;; Simplified BSD License:
;;
;; Redistribution and use in source and binary forms, with or
;; without modification, are permitted provided that the following
;; conditions are met:
;;
;; 1. Redistributions of source code must retain the above
;; copyright notice, this list of conditions and the following
;; disclaimer.
;;
;; 2. Redistributions in binary form must reproduce the above
;; copyright notice, this list of conditions and the following
;; disclaimer in the documentation and/or other materials
;; provided with the distribution.
;;
;; This software is provided by Roland Walker "AS IS" and any express
;; or implied warranties, including, but not limited to, the implied
;; warranties of merchantability and fitness for a particular
;; purpose are disclaimed. In no event shall Roland Walker or
;; contributors be liable for any direct, indirect, incidental,
;; special, exemplary, or consequential damages (including, but not
;; limited to, procurement of substitute goods or services; loss of
;; use, data, or profits; or business interruption) however caused
;; and on any theory of liability, whether in contract, strict
;; liability, or tort (including negligence or otherwise) arising in
;; any way out of the use of this software, even if advised of the
;; possibility of such damage.
;;
;; The views and conclusions contained in the software and
;; documentation are those of the authors and should not be
;; interpreted as representing official policies, either expressed
;; or implied, of Roland Walker.
;;
;;; Code:
;;
;;; requirements
;; for decf, callf, position
(require 'cl)
(require 'smartrep nil t)
(require 'nav-flash nil t)
(require 'visible-mark nil t)
;;; declarations
(declare-function smartrep-define-key "smartrep.el")
(declare-function visible-mark-initialize-overlays "visible-mark.el")
(declare-function visible-mark-move-overlays "visible-mark.el")
(declare-function back-button-push-mark "back-button.el")
(eval-when-compile
(defvar visible-mark-mode)
(defvar visible-mark-overlays))
;;; customizable variables
;;;###autoload
(defgroup back-button nil
"Visual navigation through mark rings."
:version "0.6.8"
:link '(emacs-commentary-link :tag "Commentary" "back-button")
:link '(url-link :tag "GitHub" "http://github.com/rolandwalker/back-button")
:link '(url-link :tag "EmacsWiki" "http://emacswiki.org/emacs/BackButton")
:prefix "back-button-"
:group 'convenience
:group 'navigation)
(defcustom back-button-mode-lighter " back"
"This string appears in the mode-line when `back-button-mode' is active.
Set to nil or the empty string to disable the mode-line
lighter for `back-button-mode'."
:type 'string
:group 'back-button)
(put 'back-button-mode-lighter 'risky-local-variable t)
(defcustom back-button-less-feedback nil
"Give less echo area feedback."
:type 'boolean
:group 'back-button)
(defcustom back-button-show-toolbar-buttons t
"Add buttons to the toolbar."
:type 'boolean
:group 'back-button)
(defcustom back-button-show-visible-marks t
"Temporarily show marks using `visible-mark' when available."
:type 'boolean
:group 'back-button)
(defcustom back-button-no-wrap nil
"Do not wrap around the ring when navigating marks."
:type 'boolean
:group 'back-button)
(defcustom back-button-never-push-mark nil
"Never add a mark while navigating marks.
This option makes the back-button command work more like the
standard `pop-global-mark command', but breaks the functionality
of remembering the start location."
:type 'boolean
:group 'back-button)
;;;###autoload
(defgroup back-button-index nil
"How to display the mark-ring index after interactive commands."
:group 'back-button)
(defcustom back-button-show-index 'echo
"How to display the mark-ring index.
This indicator shows progress through the ring after each
command."
:type '(choice
(const :tag "Echo Area" echo)
(const :tag "Popup" popup)
(const :tag "None" nil))
:group 'back-button-index)
(defcustom back-button-index-timeout 2
"How long to display the mark-ring index after each command.
Set to nil or 0 for no timeout."
:type 'number
:group 'back-button-index)
(defcustom back-button-spacer-char ?·
"Character used to indicate marks available for navigation."
:type 'character
:group 'back-button-index)
(defcustom back-button-thumb-char ?⨀
"Character used to indicate current mark."
:type 'character
:group 'back-button-index)
;;;###autoload
(defgroup back-button-keys nil
"Key bindings for `back-button-mode'."
:group 'back-button)
(defcustom back-button-smartrep-prefix "C-x"
"Prefix key for smartrep.el bindings.
Smartrep bindings will be installed for all back-button key
bindings which match this prefix.
The format for key sequences is as defined by `kbd'.
Set to nil or the empty string to disable smartrep for
`back-button-mode'."
:type 'string
:group 'back-button-keys)
(defcustom back-button-global-keystrokes '("C-x <C-SPC>")
"List of key sequences to invoke `back-button-global'.
The default binding overrides `pop-global-mark'.
The key bindings are in effect when `back-button-mode' minor mode
is active.
The format for key sequences is as defined by `kbd'."
:type '(repeat string)
:group 'back-button-keys)
(defcustom back-button-global-backward-keystrokes '("C-x <C-left>")
"List of key sequences to invoke `back-button-global-backward'.
The key bindings are in effect when `back-button-mode' minor mode
is active.
The format for key sequences is as defined by `kbd'."
:type '(repeat string)
:group 'back-button-keys)
(defcustom back-button-global-forward-keystrokes '("C-x <C-right>")
"List of key sequences to invoke `back-button-global-forward'.
The key bindings are in effect when `back-button-mode' minor mode
is active.
The format for key sequences is as defined by `kbd'."
:type '(repeat string)
:group 'back-button-keys)
(defcustom back-button-local-keystrokes '("C-x <SPC>")
"List of key sequences to invoke `back-button-local'.
The key bindings are in effect when `back-button-mode' minor mode
is active.
The format for key sequences is as defined by `kbd'."
:type '(repeat string)
:group 'back-button-keys)
(defcustom back-button-local-backward-keystrokes '("C-x <left>")
"List of key sequences to invoke `back-button-local-backward'.
The key bindings are in effect when `back-button-mode' minor mode
is active.
The format for key sequences is as defined by `kbd'."
:type '(repeat string)
:group 'back-button-keys)
(defcustom back-button-local-forward-keystrokes '("C-x <right>")
"List of key sequences to invoke `back-button-local-forward'.
The key bindings are in effect when `back-button-mode' minor mode
is active.
The format for key sequences is as defined by `kbd'."
:type '(repeat string)
:group 'back-button-keys)
;;; variables
(defvar back-button-mode nil "Whether `back-button-mode' minor-mode is on.")
(defvar back-button-local-marks-copy nil "A remembered set of local marks.")
(defvar back-button-global-marks-copy nil "A remembered set of global marks.")
(defvar back-button-global-disable-direction nil "Supplementary info for disabling toolbar buttons.")
(defvar back-button-commands '(
back-button-global
back-button-global-backward
back-button-global-forward
back-button-local
back-button-local-backward
back-button-local-forward
)
"List of back-button interactive navigation commands.")
(defvar back-button-lighter-menu-mouse-button 1
"Which mouse button invokes the modeline context menu.")
(defvar back-button-lighter-keymap-property 'keymap
"Which property sets the lighter keymap")
;;; compatibility functions
(unless (fboundp 'string-match-p)
;; added in 23.x
(defun string-match-p (regexp string &optional start)
"Same as `string-match' except this function does not change the match data."
(let ((inhibit-changing-match-data t))
(string-match regexp string start))))
;;; keymaps
(defvar back-button-mode-map (make-sparse-keymap) "Keymap for `back-button-mode' minor-mode.")
(let ((smart-keys nil))
(dolist (cmd back-button-commands)
(dolist (k (symbol-value (intern (concat (symbol-name cmd) "-keystrokes"))))
(when (and (not (string-match-p "mouse\\|wheel\\|button" k))
(not (get cmd :advertised-binding)))
(put cmd :advertised-binding (read-kbd-macro k)))
(if (and (featurep 'smartrep)
(stringp back-button-smartrep-prefix)
(> (length back-button-smartrep-prefix) 0)
(string-match-p (concat "\\`" back-button-smartrep-prefix "\\>") k))
(push (cons (replace-regexp-in-string
(concat "\\`" back-button-smartrep-prefix "\\>[ \t]*")
""
k)
cmd)
smart-keys)
;; else
(define-key back-button-mode-map (read-kbd-macro k) cmd))))
(when smart-keys
(smartrep-define-key back-button-mode-map back-button-smartrep-prefix smart-keys)))
;;; toolbar
(when back-button-show-toolbar-buttons
(define-key-after tool-bar-map [separator-backb] (if (boundp 'menu-bar-separator) menu-bar-separator "--"))
(tool-bar-add-item "left-arrow"
'back-button-global-backward
'back-button
:label "Back By Mark"
:visible '(and back-button-mode back-button-show-toolbar-buttons))
;; todo why is this not reliable?
;; :enable '(and (not (eq back-button-global-disable-direction 'back))
;; (> (length global-mark-ring) 0)))
(tool-bar-add-item "mpc/add"
'back-button-push-mark-local-and-global
'back-button-push
:label "push Mark"
:visible '(and back-button-mode back-button-show-toolbar-buttons))
(tool-bar-add-item "right-arrow"
'back-button-global-forward
'forward-button
:label "Forward By Mark"
:visible '(and back-button-mode back-button-show-toolbar-buttons))
;; todo why is this not reliable?
;; :enable '(and (not (eq back-button-global-disable-direction 'forward))
;; (> (length global-mark-ring) 0)
;; this-command
;; (memq this-command back-button-commands)))
;; Note, this seems to not work on some platforms, eg Cocoa
(define-key global-map (kbd "<tool-bar> <S-back-button>") 'back-button-local-backward)
(define-key global-map (kbd "<tool-bar> <S-forward-button>") 'back-button-local-forward))
;;; lighter
(defvar back-button-lighter-map (let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap "Back Button")))
(define-key menu-map [customize] '(menu-item "Customize" (lambda (e) (interactive "e") (customize-group 'back-button))))
(define-key menu-map [turn-off-back-button-mode] '(menu-item "Turn Off Back Button Mode" back-button-mode))
(define-key menu-map [separator-1] '(menu-item "--"))
(define-key menu-map [local-forward] (append '(menu-item "Local Forward" back-button-local-forward)
;; force advertised binding because of smartrep
(when (get 'back-button-local-forward :advertised-binding)
(list :keys
(format-kbd-macro
(get 'back-button-local-forward :advertised-binding))))))
(define-key menu-map [local-back] (append '(menu-item "Local Back" back-button-local-backward)
(when (get 'back-button-local-backward :advertised-binding)
(list :keys
(format-kbd-macro
(get 'back-button-local-backward :advertised-binding))))))
(define-key menu-map [forward] (append '(menu-item "Forward" back-button-global-forward)
(when (get 'back-button-global-forward :advertised-binding)
(list :keys
(format-kbd-macro
(get 'back-button-global-forward :advertised-binding))))))
(define-key menu-map [back] (append '(menu-item "Back" back-button-global-backward)
(when (get 'back-button-global-backward :advertised-binding)
(list :keys
(format-kbd-macro
(get 'back-button-global-backward :advertised-binding))))))
(define-key map (kbd "<mode-line> <wheel-up>" ) 'back-button-global-backward)
(define-key map (kbd "<mode-line> <wheel-down>" ) 'back-button-global-forward)
(define-key map (kbd "<mode-line> <C-wheel-up>" ) 'back-button-local-backward)
(define-key map (kbd "<mode-line> <C-wheel-down>" ) 'back-button-local-forward)
(define-key map (kbd "<mode-line> <mouse-4>" ) 'back-button-global-backward)
(define-key map (kbd "<mode-line> <mouse-5>" ) 'back-button-global-forward)
(define-key map (kbd "<mode-line> <C-mouse-4>" ) 'back-button-local-backward)
(define-key map (kbd "<mode-line> <C-mouse-5>" ) 'back-button-local-forward)
(define-key map (read-kbd-macro (format "<mode-line> <down-mouse-%s>" back-button-lighter-menu-mouse-button)) menu-map)
map) "Keymap for the back-button lighter.")
(when (and (stringp back-button-mode-lighter)
(> (length back-button-mode-lighter) 0))
(callf propertize back-button-mode-lighter
back-button-lighter-keymap-property back-button-lighter-map
'help-echo (format "Back-button: mouse-%s menu\nmouse-wheel and control-mouse-wheel to navigate" back-button-lighter-menu-mouse-button)))
;;; macros
(defmacro back-button-called-interactively-p (&optional kind)
"A backward-compatible version of `called-interactively-p'.
Optional KIND is as documented at `called-interactively-p'
in GNU Emacs 24.1 or higher."
(cond
((not (fboundp 'called-interactively-p))
'(interactive-p))
((condition-case nil
(progn (called-interactively-p 'any) t)
(error nil))
`(called-interactively-p ,kind))
(t
'(called-interactively-p))))
;;; aliases et al
;; this fset is done so that (although it is unused herein) the
;; following construct is legal
;; (flet ((push-mark (&optional location nomsg activate)
;; (back-button-push-mark-local-and-global location nomsg activate)))
;; ... do something that pushes the mark...)
(fset 'back-button-push-mark (symbol-function 'push-mark))
;;; Lisp interface
;; this function can replace push-mark in many circumstances
;; todo make handling of duplicates consistent btw local and global
;;;###autoload
(defun back-button-push-mark-local-and-global (&optional location nomsg activate consecutives)
"Push mark at LOCATION, and unconditionally add to `global-mark-ring'.
This function differs from `push-mark' in that `global-mark-ring'
is always updated.
LOCATION is optional, and defaults to the current point.
NOMSG and ACTIVATE are as documented at `push-mark'.
When CONSECUTIVES is set to 'limit and the new mark is in the same
buffer as the first entry in `global-mark-ring', the first entry
in `global-mark-ring' will be replaced. Otherwise, a new entry
is pushed onto `global-mark-ring'.
When CONSECUTIVES is set to 'allow-dupes, it is possible to push
an exact duplicate of the current topmost mark onto `global-mark-ring'."
(interactive)
(callf or location (point))
(back-button-push-mark location nomsg activate)
(when (or (eq consecutives 'allow-dupes)
(not (equal (mark-marker)
(car global-mark-ring))))
(when (and (eq consecutives 'limit)
(eq (marker-buffer (car global-mark-ring)) (current-buffer)))
(move-marker (car global-mark-ring) nil)
(pop global-mark-ring))
(push (copy-marker (mark-marker)) global-mark-ring)
(when (> (length global-mark-ring) global-mark-ring-max)
(move-marker (car (nthcdr global-mark-ring-max global-mark-ring)) nil)
(setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
;;; utility functions
(defun back-button-pre-command-hook ()
"Re-enable toolbar buttons and hide visible marks."
(when (and (featurep 'visible-mark)
(not visible-mark-mode))
(dolist (buf (buffer-list))
(with-current-buffer buf
(when visible-mark-overlays
(mapc 'delete-overlay visible-mark-overlays)
(setq visible-mark-overlays nil)))))
(setq back-button-global-disable-direction nil))
(defun back-button-visible-mark-show (type)
"Show marks temporarily using `visible-mark'.
TYPE may be 'global or 'local."
(when (and (featurep 'visible-mark)
(not visible-mark-mode))
(dolist (win (window-list))
(with-current-buffer (window-buffer win)
(when (not (minibufferp (current-buffer)))
(let ((visible-mark-max (length mark-ring)))
(visible-mark-initialize-overlays)
(when (fboundp 'visible-mark-initialize-faces)
(visible-mark-initialize-faces))
(let ((mark-ring mark-ring))
(when (eq type 'global)
(setq mark-ring global-mark-ring))
(visible-mark-move-overlays))))))))
(defun back-button-find-position (thumb type)
"Find the position of THUMB in the mark ring.
TYPE may be 'global or 'local."
(let ((ring global-mark-ring)
(copy back-button-global-marks-copy)
(posn nil))
(when (eq type 'local)
(setq ring mark-ring)
(setq copy back-button-local-marks-copy))
(setq posn (or (position thumb copy) 1))
;; scan across duplicates and place visible thumb
;; on a consistent boundary; looks more intuitive
(while (and (> posn 0)
(equal (nth (1- posn) copy) (nth posn copy)))
(setq posn (1- posn)))
posn))
(defun back-button-display-index (msg)
"Briefly display MSG.
MSG is expected to contain a visual representation of mark-ring
traversal progress."
(let ((message-log-max nil))
(cond
((and (eq back-button-show-index 'echo)
(numberp back-button-index-timeout)
(> back-button-index-timeout 0))
(with-temp-message msg
(sit-for back-button-index-timeout)))
((eq back-button-show-index 'echo)
(message msg))
((and (eq back-button-show-index 'popup)
(fboundp 'popup-volatile))
(popup-volatile msg :box t :around t :delay back-button-index-timeout :face '(:background "Gray20" :foreground "#C0C0C0"))))))
(defun back-button-maybe-record-start (type interactive)
"Push mark for the first of a series of interactive back-button commands.
TYPE may be 'local or 'global.
INTERACTIVE is a boolean value, noting whether this function was
called from an interactive command."
(when (and interactive
(not (memq last-command back-button-commands))
(not back-button-never-push-mark))
(cond
((eq type 'global)
(back-button-push-mark-local-and-global (point) t nil))
((eq type 'local)
;; push twice to get position onto mark-ring
(back-button-push-mark (point) t nil)
(back-button-push-mark (point) t nil)))))
;; This totally different approach (compared to pop-mark) is needed in
;; the first case b/c pop-mark creates/destroys markers, breaking the
;; memq tests used in back-button-local and back-button-find-index.
(defun back-button-pop-local-mark ()
"Pop off local `mark-ring' and jump to the top location.
This differs from `pop-mark' completely, instead following the
semantics of `pop-global-mark', moving the point instead of
setting the mark."
(when mark-ring
(let* ((marker (car mark-ring))
(position (marker-position marker)))
(setq mark-ring (nconc (cdr mark-ring)
(list (car mark-ring))))
(when (and (>= position (point-min))
(<= position (point-max)))
(if widen-automatically
(widen)
(error "Local mark position is outside accessible part of buffer")))
(goto-char position))))
;;; minor-mode setup
;;;###autoload
(define-minor-mode back-button-mode
"Turn on back-button-mode.
When called interactively with no prefix argument this command
toggles the mode. With a prefix argument, it enables the mode
if the argument is positive and otherwise disables the mode.
When called from Lisp, this command enables the mode if the
argument is omitted or nil, and toggles the mode if the argument
is 'toggle."
:lighter back-button-mode-lighter
:keymap back-button-mode-map
:group 'back-button
:global t
(cond
(back-button-mode
(add-hook 'pre-command-hook 'back-button-pre-command-hook)
(when (and (back-button-called-interactively-p 'interactive) (not back-button-less-feedback))
(message "back-button mode enabled")))
(t
(remove-hook 'pre-command-hook 'back-button-pre-command-hook)
(when (and (back-button-called-interactively-p 'interactive) (not back-button-less-feedback))
(message "back-button mode disabled")))))
;;; interactive commands
;;;###autoload
(defun back-button-local (arg)
"Navigate through `mark-ring', using `back-button-pop-local-mark'.
If the point does not move, continue popping the ring until
motion occurs.
With universal prefix ARG, rotate the ring in the opposite
direction. (The \"forward\" direction by analogy with a
web browser back-button.)"
(interactive "P")
(back-button-maybe-record-start 'local (back-button-called-interactively-p 'any))
(let ((pos (point))
(counter (length mark-ring))
(thumb nil)
(posn nil)
(stopper :no-stopper))
(when (or (not back-button-local-marks-copy)
(not (car mark-ring))
(not (memq (car mark-ring) back-button-local-marks-copy)))
(setq back-button-local-marks-copy (copy-sequence mark-ring)))
(when back-button-no-wrap
(if (consp arg)
(setq stopper (car back-button-local-marks-copy))
(setq stopper (car (last back-button-local-marks-copy)))))
(when (consp arg)
(setq mark-ring (nreverse mark-ring)))
(when back-button-no-wrap
(setq thumb (car mark-ring)))
(while (and (not (eq thumb stopper))
(eq pos (point))
(> counter 0))
(back-button-pop-local-mark)
(setq thumb (car (last mark-ring)))
(decf counter))
(when (consp arg)
(setq mark-ring (nreverse mark-ring)))
(when (and (not (eq thumb stopper))
(eq pos (point)))
(error (concat "local-mark" (if (consp arg) " forward" " back") " failed")))
(when (eq thumb stopper)
(goto-char stopper))
(setq posn (back-button-find-position thumb 'local))
(back-button-visible-mark-show 'local)
(when (fboundp 'nav-flash-show)
(nav-flash-show))
(back-button-display-index (concat "local marks "
(make-string (- (length back-button-local-marks-copy) posn 1) back-button-spacer-char)
(string back-button-thumb-char)
(make-string posn back-button-spacer-char)))))
;;;###autoload
(defun back-button-global (arg)
"Navigate through `global-mark-ring', using `pop-global-mark'.
If the point would not move, continue popping the ring until
motion occurs.
With universal prefix ARG, rotate the ring in the opposite
direction. (The \"forward\" direction by analogy with a
web browser back-button.)"
(interactive "P")
(back-button-maybe-record-start 'global (back-button-called-interactively-p 'any))
(let ((pos (point))
(buf (current-buffer))
(counter (length global-mark-ring))
(thumb nil)
(posn nil)
(stopper :no-stopper))
(when (or (not back-button-global-marks-copy)
(not (car global-mark-ring))
(not (memq (car global-mark-ring) back-button-global-marks-copy)))
(setq back-button-global-marks-copy (copy-sequence global-mark-ring)))
(when back-button-no-wrap
(if (consp arg)
(setq stopper (car back-button-global-marks-copy))
(setq stopper (car (last back-button-global-marks-copy)))))
(when (consp arg)
(setq global-mark-ring (nreverse global-mark-ring)))
(when back-button-no-wrap
(setq thumb (car global-mark-ring)))
(while (and (not (eq thumb stopper))
(or (minibufferp (current-buffer))
(and (eq pos (point))
(eq buf (current-buffer))
(> counter 0))))
(pop-global-mark)
(setq thumb (car (last global-mark-ring)))
(decf counter))
(when (consp arg)
(setq global-mark-ring (nreverse global-mark-ring)))
(when (and (not (eq thumb stopper))
(or (minibufferp (current-buffer))
(and (eq pos (point))
(eq buf (current-buffer)))))
(error (concat "global-mark" (if (consp arg) " forward" " back") " failed")))
(when (eq thumb stopper)
(setq back-button-global-disable-direction (if (consp arg) 'forward 'back))
(goto-char stopper))
(setq posn (back-button-find-position thumb 'global))
(back-button-visible-mark-show 'global)
(when (fboundp 'nav-flash-show)
(nav-flash-show))
(back-button-display-index (concat "global marks "
(make-string (- (length back-button-global-marks-copy) posn 1) back-button-spacer-char)
(string back-button-thumb-char)
(make-string posn back-button-spacer-char)))))
;;;###autoload
(defun back-button-local-backward ()
"Run `back-button-local' in the backward direction.
Unlike `back-button-local', ignores any prefix argument.
This command is somewhat like a fancier version of
`pop-to-mark-command', though it leaves the mark and
`mark-ring' in a different state."
(interactive)
(back-button-maybe-record-start 'local (back-button-called-interactively-p 'any))
(back-button-local nil))
;;;###autoload
(defun back-button-local-forward ()
"Run `back-button-local' in the forward direction.
Unlike `back-button-local', ignores any prefix argument.
This command is somewhat like the reverse of
`pop-to-mark-command'."
(interactive)
(back-button-maybe-record-start 'local (back-button-called-interactively-p 'any))
(back-button-local '(4)))
;;;###autoload
(defun back-button-global-backward ()
"Run `back-button-global' in the backward direction.
Unlike `back-button-global', ignores any prefix argument.
This command is much like a fancier version of
`pop-global-mark'."
(interactive)
(back-button-maybe-record-start 'global (back-button-called-interactively-p 'any))
(back-button-global nil))
;;;###autoload
(defun back-button-global-forward ()
"Run `back-button-global' in the forward direction.
Unlike `back-button-global', ignores any prefix argument.
This command is much like the reverse of `pop-global-mark'."
(interactive)
(back-button-maybe-record-start 'global (back-button-called-interactively-p 'any))
(back-button-global '(4)))
(provide 'back-button)
;;
;; Emacs
;;
;; Local Variables:
;; indent-tabs-mode: nil
;; mangle-whitespace: t
;; require-final-newline: t
;; coding: utf-8
;; byte-compile-warnings: (not cl-functions redefine)
;; End:
;;
;; LocalWords: BackButton smartrep NOMSG CONSECUTIVES fset nomsg
;; LocalWords: callf imenu utils pcache devel flet
;;
;;; back-button.el ends here