emacs/lisp/my/my-tool-bar.el

;;; my-tool-bar.el --- Tool bar  -*- lexical-binding: t -*-

;;; Commentary:

;;; Code:
(defun my-tool-bar-newline ()
  "Newline."
  "\n")

(defvar my-tool-bar-separator " "
  "Separator.")

(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-undo (event)
  "Run `undo-only'."
  (interactive "e")
  (let ()
    (undo-only)))
(defvar my-tool-bar-button-undo "Undo "
  "Button to run `undo-only'.")

(defun my-tool-bar-function-redo (event)
  "Run `undo-redo'."
  (interactive "e")
  (let ()
    (undo-redo)))
(defvar my-tool-bar-button-redo "Redo "
  "Button to run `undo-redo'.")

(defun my-tool-bar-function-cut (event)
  "Run `kill-region'."
  (interactive "e")
  (let ()
    (kill-region (mark) (point))))
(defvar my-tool-bar-button-cut "Cut "
  "Button to run `cut-region'.")

(defun my-tool-bar-function-copy (event)
  "Run `kill-ring-save'."
  (interactive "e")
  (let ()
    (kill-ring-save (mark) (point))))
(defvar my-tool-bar-button-copy "Copy "
  "Button to run `kill-ring-save'.")

(defun my-tool-bar-function-paste (event)
  "Run `yank'."
  (interactive "e")
  (let ()
    (yank)))
(defvar my-tool-bar-button-paste "Paste "
  "Button to run `yank'.")

(defun my-tool-bar-function-fill (event)
  "Run `fill-paragraph'."
  (interactive "e")
  (let ()
    (fill-paragraph)))
(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-langtool-active-p ()
  "Check if `langtool-check-buffer' is active."
  (save-excursion
    (not (null (langtool--overlays-region (point-min) (point-max))))))
(defun my-tool-bar-function-langtool (event)
  "Run `langtool-check-buffer'."
  (interactive "e")
  (let ()
    (if (my-langtool-active-p)
        (langtool-check-done)
      (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
       ;; :enable buffer-modified-p
       :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'")
      (undo
       menu-item ,my-tool-bar-button-undo my-tool-bar-function-undo
       :help "Undo `undo-only'")
      (redo
       menu-item ,my-tool-bar-button-redo my-tool-bar-function-redo
       :help "Redo `undo-redo'")
      (cut
       menu-item ,my-tool-bar-button-cut my-tool-bar-function-cut
       :help "Cut text of region `kill-region'")
      (copy
       menu-item ,my-tool-bar-button-copy my-tool-bar-function-copy
       :help "Copy text of region `kill-ring-save'")
      (paste
       menu-item ,my-tool-bar-button-paste my-tool-bar-function-paste
       :help "Paste text `yank'")
      (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)
      ;; (sep-2 menu-item ,my-tool-bar-separator ignore
      ;;        :enable nil :help "")
      (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)
  ;; zoom in (symbol "🗚 ")
  ;; zoom out (symbol "🗛 ")
  ;; help/info (emoji "🛟") (emoji "❓")

  (unless (iconp 'my-tool-bar-icon-separator)
    (define-icon my-tool-bar-icon-separator nil
      `((image "separator.xpm"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (text " "
              ;; :face tab-bar-tab-inactive
              ))
      "Icon for save."
      :version "29.1"))
  (setq my-tool-bar-separator (icon-string 'my-tool-bar-icon-separator))

  (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)
        (emoji "❌")
        (symbol "🗙 ")  ;; 🗙 𐌗
        (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)
        (symbol "♺ ")  ; ⮔ ♺
        (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-undo)
    (define-icon my-tool-bar-icon-undo nil
      `((image "undo.xpm"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "↩ ")
        (text "Undo "
              ;; :face tab-bar-tab-inactive
              ))
      "Icon for undo."
      :version "29.1"))
  (setq my-tool-bar-button-undo (icon-string 'my-tool-bar-icon-undo))

  (unless (iconp 'my-tool-bar-icon-redo)
    (define-icon my-tool-bar-icon-redo nil
      `((image "redo.xpm"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "↪ ")
        (text "Redo "
              ;; :face tab-bar-tab-inactive
              ))
      "Icon for redo."
      :version "29.1"))
  (setq my-tool-bar-button-redo (icon-string 'my-tool-bar-icon-redo))

  (unless (iconp 'my-tool-bar-icon-cut)
    (define-icon my-tool-bar-icon-cut nil
      `((image "cut.xpm"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (emoji "✂️")
        (symbol "✀ ")
        (text "Cut "
              ;; :face tab-bar-tab-inactive
              ))
      "Icon for cut region."
      :version "29.1"))
  (setq my-tool-bar-button-cut (icon-string 'my-tool-bar-icon-cut))

  (unless (iconp 'my-tool-bar-icon-copy)
    (define-icon my-tool-bar-icon-copy nil
      `((image "copy.xpm"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "🗐 ")
        (text "Copy "
              ;; :face tab-bar-tab-inactive
              ))
      "Icon for copy region."
      :version "29.1"))
  (setq my-tool-bar-button-copy (icon-string 'my-tool-bar-icon-copy))

  (unless (iconp 'my-tool-bar-icon-paste)
    (define-icon my-tool-bar-icon-paste nil
      `((image "paste.xpm"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (emoji "📋")
        (symbol "🗎 ")
        (text "Paste "
              ;; :face tab-bar-tab-inactive
              ))
      "Icon for paste."
      :version "29.1"))
  (setq my-tool-bar-button-paste (icon-string 'my-tool-bar-icon-paste))

  (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)
        (symbol "≣ ")
        (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
               )
        (symbol "⎁ ")  ;; ⎀ ⎁ ⎂
        (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
               )
        (symbol "ℒ ")
        (text "langtool "
              ;; :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