Files
emacs/lisp/my/my-tool-bar.el
2025-07-02 14:11:17 +02:00

246 lines
7.6 KiB
EmacsLisp

;;; my-tool-bar.el --- Tool bar -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
(defun my-tool-bar-newline ()
"Newline."
"\n")
(defun my-tool-bar-function-save (event)
"Run `save-buffer'."
(interactive "e")
(let ()
;;(message "%s" event)
(save-buffer)
;;(message "foo")
))
(defvar my-tool-bar-button-save "Save "
"Button to run `save-buffer'.")
(defun my-tool-bar-function-open (event)
"Run `find-file' or 'counsel-find-file' if available."
(interactive "e")
(let ()
(if (featurep 'counsel)
(counsel-find-file)
(find-file))))
(defvar my-tool-bar-button-open "Open "
"Button to run `find-file' or `counsel-find-file' if available.")
(defun my-tool-bar-function-cancle (event)
"Run `keyboard-escape-quit'."
;; "Run `keyboard-quit'."
(interactive "e")
(let ()
;; (keyboard-quit)
(keyboard-escape-quit)))
(defvar my-tool-bar-button-cancle "Cancle "
"Button to run `keyboard-escape-quit'.")
;; "Button to run `keyboard-quit'."
(defun my-tool-bar-function-revert (event)
"Run `revert-buffer'."
(interactive "e")
(let ()
(revert-buffer)))
(defvar my-tool-bar-button-revert "Revert "
"Button to run `revert-buffer'.")
(defun my-tool-bar-function-fill (event)
"Run `fill-region'."
(interactive "e")
(let ()
(fill-region)))
(defvar my-tool-bar-button-fill "Fill "
"Button to run `fill-region'.")
(defun my-tool-bar-function-spell (event)
"Run `flyspell-buffer'."
(interactive "e")
(let ()
(flyspell-buffer)))
(defvar my-tool-bar-button-spell "Spell "
"Button to run `flyspell-buffer'.")
(defun my-tool-bar-function-langtool (event)
"Run `langtool-check-buffer'."
(interactive "e")
(let ()
(langtool-check-buffer)))
(defvar my-tool-bar-button-langtool "langtool "
"Button to run `langtool-check-buffer'.")
;; (defun my-tool-bar-format-save ()
;; "Produce the Menu button for the tool bar that shows the menu bar."
;; `((menu-bar menu-item ,my-tool-bar-button-save
;; my-tool-bar-function-save :help "Save buffer")))
(defun my-tool-bar-format ()
"Produce tool-bar buttons for the tab bar.
These buttons will be shown when `my-tool-bar-mode' is enabled.
You can hide these buttons by customizing `tab-bar-format' and removing
`my-tool-bar-format' from it."
(when my-tool-bar-mode
`(;;(sep-history-back menu-item ,(tab-bar-separator) ignore)
(save
menu-item ,my-tool-bar-button-save my-tool-bar-function-save
:help "Save `save-buffer'")
;;(sep-test menu-item "" ignore)
(open
menu-item ,my-tool-bar-button-open my-tool-bar-function-open
:help "Open File... `find-file'")
(cancle
menu-item ,my-tool-bar-button-cancle my-tool-bar-function-cancle
:help "Cancle `keyboard-escape-quit'")
(sep-1 menu-item ,(tab-bar-separator) ignore)
(revert
menu-item ,my-tool-bar-button-revert my-tool-bar-function-revert
:help "Re-read current buffer from its file `revert-buffer'")
(fill
menu-item ,my-tool-bar-button-fill my-tool-bar-function-fill
:help "Fill text in region to fit between left and right margin `fill-region'")
(sep-2 menu-item ,(tab-bar-separator) ignore)
(spell
menu-item ,my-tool-bar-button-spell my-tool-bar-function-spell
:help "Spell `flyspell-buffer'")
(langtool
menu-item ,my-tool-bar-button-langtool my-tool-bar-function-langtool
:help "languagetool `langtool-check-buffer'")
(sep-tool-bar menu-item ,(my-tool-bar-newline) ignore))))
(defun my-tool-bar--load-buttons ()
"Load the icons for the tool bar buttons.
See `image-load-path' for possible locations for images.
See `icon-preference' for the order of type preference."
;; (emoji "<empji>") see e.g. https://emojipedia.org/hamburger
;; (symbol "<unicode>") see e.g. https://www.compart.com/en/unicode/U+2630
(require 'icons)
(unless (iconp 'my-tool-bar-icon-save)
(define-icon my-tool-bar-icon-save nil
`((image "save.xpm"
:height (1.5 . em)
:margin ,tab-bar-button-margin
:ascent center)
(emoji "💾")
(symbol "🖫")
(text "Save"
;; :face tab-bar-tab-inactive
))
"Icon for save."
:version "29.1"))
(setq my-tool-bar-button-save (icon-string 'my-tool-bar-icon-save))
(unless (iconp 'my-tool-bar-icon-open)
(define-icon my-tool-bar-icon-open nil
`((image "open.xpm"
:height (1.5 . em)
:margin ,tab-bar-button-margin
:ascent center)
(emoji "📂")
(symbol "🗁")
(text "Open"
;; :face tab-bar-tab-inactive
))
"Icon for open file."
:version "29.1"))
(setq my-tool-bar-button-open (icon-string 'my-tool-bar-icon-open))
(unless (iconp 'my-tool-bar-icon-cancle)
(define-icon my-tool-bar-icon-cancle nil
`((image "cancel.xpm"
:height (1.5 . em)
:margin ,tab-bar-button-margin
:ascent center)
(text "Quit"
;; :face tab-bar-tab-inactive
))
"Icon for quit."
:version "29.1"))
(setq my-tool-bar-button-cancle (icon-string 'my-tool-bar-icon-cancle))
(unless (iconp 'my-tool-bar-icon-revert)
(define-icon my-tool-bar-icon-revert nil
`((image "refresh.xpm"
:height (1.5 . em)
:margin ,tab-bar-button-margin
:ascent center)
(text "Revert"
;; :face tab-bar-tab-inactive
))
"Icon for revert buffer."
:version "29.1"))
(setq my-tool-bar-button-revert (icon-string 'my-tool-bar-icon-revert))
(unless (iconp 'my-tool-bar-icon-fill)
(define-icon my-tool-bar-icon-fill nil
`((image "newsticker/narrow.xpm"
:height (1.5 . em)
:margin ,tab-bar-button-margin
:ascent center)
(text "Fill"
;; :face tab-bar-tab-inactive
))
"Icon for fill region."
:version "29.1"))
(setq my-tool-bar-button-fill (icon-string 'my-tool-bar-icon-fill))
(unless (iconp 'my-tool-bar-icon-spell)
(define-icon my-tool-bar-icon-spell nil
`((image "spell.xpm"
:height (1.5 . em)
:margin ,tab-bar-button-margin
:ascent center
)
(text "Spell"
;; :face tab-bar-tab-inactive
))
"Icon for spell."
:version "29.1"))
(setq my-tool-bar-button-spell (icon-string 'my-tool-bar-icon-spell))
(unless (iconp 'my-tool-bar-icon-langtool)
(define-icon my-tool-bar-icon-langtool nil
`((image "languagetool.org.xpm"
:height (1.5 . em)
:margin ,tab-bar-button-margin
:ascent center
)
(text "languagetool"
;; :face tab-bar-tab-inactive
))
"Icon for languagetool."
:version "29.1"))
(setq my-tool-bar-button-langtool (icon-string 'my-tool-bar-icon-langtool))
)
(define-minor-mode my-tool-bar-mode
"Toggle tool bar mode for the tab bar.
Tool bar mode displays action buttons.
It will enable `tab-bar-mode' if not already."
:global t :group 'tab-bar
(if my-tool-bar-mode
(progn
(my-tool-bar--load-buttons)
(unless tab-bar-mode
(tab-bar-mode 1))
;;(add-hook 'pre-command-hook #'tab-bar--history-pre-change)
;;(add-hook 'window-configuration-change-hook #'tab-bar--history-change)
)
;;(remove-hook 'pre-command-hook #'tab-bar--history-pre-change)
;;(remove-hook 'window-configuration-change-hook #'tab-bar--history-change)
))
(provide 'my-tool-bar)
;;; my-tool-bar.el ends here