tab-line: cycle through groups

tab-line: cycle through groups

[PEDRO ANDRES ARANDA GUTIERREZ]

[-- Attachment #1: Type: text/plain, Size: 640 bytes --]

Hi,

I’ve been using tab-line for some time now (and complained a lot, thanks for the patience :-P ) I would like to suggest including the possibility of cycling between different file groups.
I’m attaching parts of an ELISP file I load from init.el that implements this function. I’m sure there are thousands of things that will strike you, so take it as concept level code with the ‘works for tm (tm)’ caveat 

Best, /PA


—
PEDRO ANDRES ARANDA GUTIERREZ
paranda@it.uc3m.es
Universidad Carlos III Madrid

Fragen sind nicht da um beantwortet zu werden…
Fragen sind da, um gestellt zu werden.
Georg Kreisler


[-- Attachment #2.1: Type: text/html, Size: 781 bytes --]

[-- Attachment #2.2: my-tabline.el --]
[-- Type: application/octet-stream, Size: 4933 bytes --]

;;
;; Now customize the tab-line behaviour
;;
(require 'tab-line)

(defun down-buffer-name (buf)
  "return downcase buffer name"
  (downcase (buffer-name buf)))

(defun downcase-bname-cmp (b1 b2)
  "Compare two buffer names"
  (string< (down-buffer-name b1)
		   (down-buffer-name b2)))

(defun downcase-string-cmp (s1 s2)
  "Compare two buffer names"
  (string< (downcase s1)
		   (downcase s2)))

(defun sorted-buffer-list ()
  "return a sorted list of buffers (by name)"
  (sort (buffer-list) 'downcase-bname-cmp))

;; Set associations between the buffer mode and the buffer group
;; Use `nil' to ignore buffer in tab-line

(setq group-mode-list '((lisp-interaction-mode .    "System")
						            (messages-buffer-mode .     "System")
						            (special-mode .             "System")
						            (compilation-mode .         "System")
						            (bibtex-mode .              "Biblio")
						            (texlog-mode .              "All")))
;;
;; Create a groups list
;; TODO: function and key bindng to toggle between groups
;;
(setq groups-list
	  (delete-dups (append
					(remove-if-not
					 (lambda (elem) elem)
					 (mapcar (lambda (elem)
							   (cdr elem))
							 (copy-alist group-mode-list)))
					'("All"))))			; include all groups that are not in the list
										; but appear in the group function

(defun my-tab-line-tabs-buffer-group(buf)
  "Return the buffer group of a buffer"
  (interactive "bBuffer: ")
  (let* ((bname  (buffer-name buf))
		 (bmode  (buffer-mode buf))
		 (bassoc (assoc bmode group-mode-list)))
	(cond
	 ((member bmode tab-line-exclude-modes) nil)
	 ((string-match "^ \\\*org-src-fontification:[^*]+\\\*" bname) nil)
	 ((string-match "^\\\*Compile" bname) nil)
	 ((string-match "^\\\*testing snippet:[^*]+\\\*" bname) "System")
	 ((string-match "^\\\*Shell Command Output\\\*" bname) "System")
	 ((string-match "^\\\*Warnings\\\*" bname) "All") ; make the warnings show up with the 'normal' files
	 (bassoc (cdr bassoc))
	 (t      "All"))))

;;
;; An alias
;;
(defun buffer-group-name (buf)
  (my-tab-line-tabs-buffer-group buf))

(defun my-tab-line-tabs-buffer--by-group-list ()
  "Produce a list of buffers of the same kind as the current buffer"
  (let ((blist (sorted-buffer-list))
		(btype (my-tab-line-tabs-buffer-group (current-buffer))))
	(remove-if-not
	 (lambda (buf)
	   (let ((ctype (my-tab-line-tabs-buffer-group buf)))
		 (and ctype btype (string= btype ctype))))
	 blist)))

(defun my-tab-line-tabs-buffer--all-groups-list ()
  "Produce a list of buffers of the same kind as the current buffer"
  (let ((blist (sorted-buffer-list)))
	(remove-if-not
	 (lambda (buf)
	   (my-tab-line-tabs-buffer-group buf))
	 blist)))

(defun my-tab-line-tabs-buffer-list ()
  (my-tab-line-tabs-buffer--by-group-list))

;;
;; Keep this until emacs-28
;;
(defun my-next-buffer ()
  "select the next buffer based on the sorted list"
  (interactive)
  (let* ((blist    (my-tab-line-tabs-buffer-list)) ; the current buffer list
         (buf      (current-buffer)))              ; the current buffer
    (switch-to-buffer (next-elem blist buf))))

(defun active-groups()
  "get a sorted list of active groups"
  (let* ((blist (sorted-buffer-list))
		     (tlist (mapcar (lambda (element)
						              (buffer-group-name element))
                        blist))) ;; groups of all buffers
	  (delete-dups						     ; remove duplicates
	   (sort								       ; sort buffer group names
	    (remove-if-not					   ; remove 'hidden' buffers
	     (lambda (typ) typ) tlist)
	    'downcase-string-cmp))))

(defun tab-line-turn-off ()
  "Turn the tab-line unconditionally off"
  (interactive)
  (tab-line-mode -1))

(defun my-next-group-buffer ()
  "select next buffer in buffer list in next group"
  (interactive)
  (let* ((debug     nil)
		     (blist     (sorted-buffer-list))
		     (bcurrent  (current-buffer))
		     (bgroup    (buffer-group-name bcurrent))
		     (glist     (active-groups)))
	  (when debug
	    (message "next.group\n blist %s" blist)
	    (message " bcurrent %s" bcurrent)
	    (message " bgroup %s" bgroup)
	    (message " glist %s" glist))
	  (when (or (not bgroup) (> (length glist) 1))
	    ;; when the current buffer is hidden or there is more than 1 group
	    (setq bgroup
			      ;; When the current buffer is in the list of hidden buffers
			      (if (not bgroup)
				        ;; Go to the next buffer in the first group shown
				        (car glist)
			        ;; else go to the next buffer in the next group
			        (next-elem glist bgroup)))
      (when debug
        (message "Next group is %s" bgroup))
	    (while (not (string= (buffer-group-name bcurrent) bgroup))
		    (setq bcurrent (next-elem blist bcurrent)))
	    (switch-to-buffer bcurrent))))

(setq-default tab-line-tabs-function
			        'my-tab-line-tabs-buffer-list)
(setq-default tab-line-tabs-buffer-group-function
			        'my-tab-line-tabs-buffer-group)

[-- Attachment #2.3: Type: text/html, Size: 1322 bytes --]