Browse code

Added previous-buffer binding/feature. (Note: Displaces 'Select buffer' binding, check config.lisp)

Jenga Phoenix authored on 2019-03-31 04:08:08
Showing 3 changed files
... ...
@@ -59,8 +59,9 @@
59 59
 (defparameter *key-save-as-file-browser* "<Control-Alt-s>" "Save the current file under a new name, with browser GUI")
60 60
 (defparameter *key-reload-file* "<Control-r>" "Re-load the current file")
61 61
 (defparameter *key-compile-file* "<Control-k>" "Compile the current file")
62
-(defparameter *key-next-file* "<Control-b>" "Cycle through open files")
63
-(defparameter *key-select-file* "<Control-B>" "Select open file")
62
+(defparameter *key-previous-file* "<Control-B>" "Cycle to previous open files")
63
+(defparameter *key-next-file* "<Control-b>" "Cycle to next open files")
64
+(defparameter *key-select-file* "<Control-Alt-b>" "Select open file")
64 65
 (defparameter *key-find* "<Control-f>" "Find text in current file")
65 66
 (defparameter *key-find-again* "<Control-g>" "Repeat the previous search")
66 67
 (defparameter *key-cut* "<Control-x>" "Cut the selected text")
... ...
@@ -123,3 +124,5 @@
123 124
 
124 125
 
125 126
 
127
+
128
+
... ...
@@ -30,6 +30,7 @@
30 30
 
31 31
     "Buffers"	"Buffers"
32 32
     ;; ----------
33
+    "Last buffer" "Last buffer"
33 34
     "Next buffer" "Next buffer"
34 35
     "Close buffer" "Close buffer"
35 36
     "Select buffer" "Select buffer"
... ...
@@ -119,6 +120,7 @@
119 120
 
120 121
     "Buffers"	"Bufroj"
121 122
     ;; ----------
123
+    "Last buffer" "Malsekva bufro"
122 124
     "Next buffer" "Sekva bufro"
123 125
     "Close buffer"
124 126
     "Fermi bufron"
... ...
@@ -183,3 +185,5 @@
183 185
     "nekonservitaj dosieroj ekzistas...ĉu kvankam ĉesi?"))
184 186
 
185 187
 
188
+
189
+
... ...
@@ -643,25 +643,37 @@
643 643
     (setf (file-path buffer) file-path))
644 644
   (pathname-message))
645 645
 
646
-(defmethod get-next-buffer ((buffer buffer) (buffer-manager buffer-manager))
647
-  (let* ((next)
648
-         (retval)
649
-         (buffers (reverse (buffers buffer-manager))))
650
-    (loop for b in buffers do
651
-      (unless retval
652
-        (setf retval b))
653
-      (when next
654
-        (setf retval b)
655
-        (setf next nil))
656
-      (if (string= (file-path b) (file-path buffer))
657
-          (setf next t)))
658
-    (when retval
659
-      (file-path retval))))
646
+(defmacro get-directional-buffer-name (index-change greater-or-less-than limit default-pos)
647
+  "Generate code for getting the name of a certainly-directioned buffer-- I.E., next/previous."
648
+  `(let* ((buffers (reverse (buffers buffer-manager)))
649
+         (cur-buffer-pos (position buffer buffers))
650
+         (other-buffer-pos (,index-change cur-buffer-pos)))
651
+    (when (,greater-or-less-than cur-buffer-pos ,limit)
652
+      (setq other-buffer-pos ,default-pos))
653
+    (file-path (nth other-buffer-pos buffers ))))
654
+
655
+;; these two methods have almost identifcal code
656
+(defmethod get-next-buffer-name ((buffer buffer) (buffer-manager buffer-manager))
657
+  "Return the name of the next buffer."
658
+  (get-directional-buffer-name 1+ >= (1- (length buffers)) 0))
659
+
660
+(defmethod get-previous-buffer-name ((buffer buffer) (buffer-manager buffer-manager))
661
+  "Return the name of the previous buffer."
662
+  (get-directional-buffer-name 1- <= 0 (1- (length buffers))))
663
+
664
+(defmacro select-directional-buffer (directional-buffer-name-function)
665
+  "Return code for selecting a buffer (as selected by the passed function returning it's name)."
666
+  `(let ((other-buffer (,directional-buffer-name-function buffer buffer-manager)))
667
+     (when (and other-buffer (not (string= (file-path buffer) other-buffer)))
668
+       (select-buffer buffer-manager other-buffer))))
660 669
 
661 670
 (defmethod select-next-buffer ((buffer-manager buffer-manager) (buffer buffer))
662
-  (let ((next-buffer (get-next-buffer buffer buffer-manager)))
663
-    (when (and next-buffer (not (string= (file-path buffer) next-buffer)))
664
-      (select-buffer buffer-manager next-buffer))))
671
+  "Select the next buffer."
672
+  (select-directional-buffer get-next-buffer-name))
673
+
674
+(defmethod select-previous-buffer ((buffer-manager buffer-manager) (buffer buffer))
675
+  "Select the previous buffer."
676
+  (select-directional-buffer get-previous-buffer-name))
665 677
 
666 678
 (defmethod at-least-one-buffer-p ((buffer-manager buffer-manager))
667 679
   (> (length (buffers buffer-manager)) 0))
... ...
@@ -675,14 +687,13 @@
675 687
     (ltk::reset-modify editor)))
676 688
 
677 689
 (defmethod close-buffer ((buffer buffer) (buffer-manager buffer-manager))
690
+  (select-next-buffer buffer-manager buffer)
678 691
   (setf (buffers buffer-manager) (remove buffer (buffers buffer-manager) :test #'equalp))
679 692
   (update-current-buffers buffer-manager)
680
-  (let ((nextfile (get-next-buffer buffer buffer-manager)))
681
-    (select-next-buffer buffer-manager buffer)
682
-    (ltk:pack-forget buffer)
683
-    (case (at-least-one-buffer-p buffer-manager)
684
-      ((t) (pathname-message))
685
-      ((nil) (shutdown)))))
693
+  (ltk:pack-forget buffer)
694
+  (case (at-least-one-buffer-p buffer-manager)
695
+    ((t) (pathname-message))
696
+    ((nil) (shutdown))))
686 697
 
687 698
 (defclass listener (ltk:frame)
688 699
   ((inferior-win
... ...
@@ -1037,6 +1048,7 @@
1037 1048
      (list *key-find-again* 'on-search-again)
1038 1049
      (list *key-goto-line* 'on-goto)
1039 1050
      (list *key-asdf-load* 'on-asdf-load)
1051
+     (list *key-previous-file* 'on-previous-file)
1040 1052
      (list *key-next-file* 'on-next-file)
1041 1053
      (list *key-select-file* 'on-select-file)
1042 1054
      (list *key-reload-file* 'on-reload-file)
... ...
@@ -1119,6 +1131,7 @@
1119 1131
         (action #t"Find again" on-search-again)
1120 1132
         (action #t"Goto line" on-goto))
1121 1133
       (with-menu mbuffer
1134
+        (action #t"Last buffer" on-previous-file)
1122 1135
         (action #t"Next buffer" on-next-file)
1123 1136
         (separator)
1124 1137
         (action #t"Close buffer" on-close-file)
... ...
@@ -1287,6 +1300,9 @@
1287 1300
 (defun on-next-file (&optional event)
1288 1301
   (select-next-buffer *buffer-manager* (selected-buffer *buffer-manager*)))
1289 1302
 
1303
+(defun on-previous-file (&optional event)
1304
+  (select-previous-buffer *buffer-manager* (selected-buffer *buffer-manager*)))
1305
+
1290 1306
 (defun on-select-file (&optional n)
1291 1307
   (unless (integerp n)
1292 1308
     (setf n (parse-integer (input-prompt *listener* #t"buffer number:"))))
... ...
@@ -1514,3 +1530,7 @@
1514 1530
 
1515 1531
 
1516 1532
 
1533
+
1534
+
1535
+
1536
+