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-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-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-save-as (event)
  "Run `my-org-export'."
  (interactive "e")
  (let ()
    (my-org-export) ))
(defvar my-tool-bar-button-save "Save as "
  "Button to run `my-org-export'.")

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

(defun my-tool-bar-function-next-buffer (event)
  "Run `next-buffer'."
  (interactive "e")
  (let ()
    (next-buffer)))
(defvar my-tool-bar-button-next-buffer "Next buffer "
  "Button to run `next-buffer'.")

(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-comment (event)
  "Run `comment-or-uncomment-region'."
  (interactive "e")
  (let ()
    (comment-or-uncomment-region (region-beginning) (region-end))
    ;; (comment-dwim)
    ))
(defvar my-tool-bar-button-comment "Comment "
  "Button to run `comment-or-uncomment-region'.")

(defun my-hide-elements ()
  "."
  (interactive "e")
  (let ()
    (pcase major-mode
      ('org-mode
       (let ()
         (my-org-toggle-elements)
         ))
      (_ (message "%s: %s" "not defined for this major-mode"
                  major-mode)) )
    ))
(defun my-tool-bar-function-hide (event)
  "Run `my-hide-elements' inside org-mode."
  (interactive "e")
  (let ()
    (my-hide-elements)))
(defvar my-tool-bar-button-hide "(Un)hide "
  "Button to run `my-hide-elements' inside org-mode.")

(defun my-tool-bar-function-spell (event)
  "Run `flyspell-mode' and `flyspell-buffer'."
  (interactive "e")
  (if flyspell-mode
      (flyspell-mode -1)
    (flyspell-mode 1)     ;; local on-the-fly
    (flyspell-buffer) ))  ;; whole buffer
(defvar my-tool-bar-button-spell "Spell "
  "Button to run `flyspell-mode' and `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-function-play (event)
  "Run `C-c'."
  (interactive "e")
  (let ()
    (pcase major-mode
      ('org-mode (org-ctrl-c-ctrl-c))
      (_ (message "%s: %s" "not defined for this major-mode"
                  major-mode)) )))
(defvar my-tool-bar-button-play "Cc "
  "Button to run `C-c'.")

(defun my-tool-bar-function-read (event)
  "Run `my-distraction-free'."
  (interactive "e")
  (let ()
    (my-distraction-free) ))
(defvar my-tool-bar-button-read "Rdv "
  "Button to run `my-distraction-free'.")

;; (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."
  ;; (propertize "`save-buffer'" 'face '(:foreground "red"))
  ;; (propertize "`save-buffer'" 'face 'font-lock-constant-face)
  (when my-tool-bar-mode
    `(;;(sep-history-back menu-item ,(tab-bar-separator) ignore)
      ;;(sep-test menu-item "" ignore)
      (open
       menu-item ,my-tool-bar-button-open my-tool-bar-function-open
       :help (concat "Open File... "
                     (propertize "`find-file'"
                                 'face 'font-lock-constant-face)))
      (save
       menu-item ,my-tool-bar-button-save my-tool-bar-function-save
       ;; :enable buffer-modified-p
       :help (concat "Save "
                     (propertize "`save-buffer'"
                                 'face 'font-lock-constant-face)))
      (save-as
       menu-item ,my-tool-bar-button-save-as my-tool-bar-function-save-as
       :help (concat "Save as "
                     (propertize "`my-org-export'"
                                 'face 'font-lock-constant-face)))
      (prev
       menu-item ,my-tool-bar-button-previous-buffer my-tool-bar-function-previous-buffer
       :help (concat "Previous buffer "
                     (propertize "`previous-buffer'"
                                 'face 'font-lock-constant-face)))
      (next
       menu-item ,my-tool-bar-button-next-buffer my-tool-bar-function-next-buffer
       :help (concat "Next buffer "
                     (propertize "`next-buffer'"
                                 'face 'font-lock-constant-face)))
      (cancle
       menu-item ,my-tool-bar-button-cancle my-tool-bar-function-cancle
       :help (concat "Cancle "
                     (propertize "`keyboard-escape-quit'"
                                 'face 'font-lock-constant-face)))

      (revert
       menu-item ,my-tool-bar-button-revert my-tool-bar-function-revert
       :help (concat "Re-read current buffer from its file "
                     (propertize "`revert-buffer'"
                                 'face 'font-lock-constant-face)))

      ;; (sep-1 menu-item ,(tab-bar-separator) ignore)
      (sep-1 menu-item "  " ignore :enable nil :help "")

      (undo
       menu-item ,my-tool-bar-button-undo my-tool-bar-function-undo
       :help (concat "Undo "
                     (propertize "`undo-only'"
                                 'face 'font-lock-constant-face)))
      (redo
       menu-item ,my-tool-bar-button-redo my-tool-bar-function-redo
       :help (concat "Redo "
                     (propertize "`undo-redo'"
                                 'face 'font-lock-constant-face)))
      (cut
       menu-item ,my-tool-bar-button-cut my-tool-bar-function-cut
       :help (concat "Cut text of region "
                     (propertize "`kill-region'"
                                 'face 'font-lock-constant-face)))
      (copy
       menu-item ,my-tool-bar-button-copy my-tool-bar-function-copy
       :help (concat "Copy text of region "
                     (propertize "`kill-ring-save'"
                                 'face 'font-lock-constant-face)))
      (paste
       menu-item ,my-tool-bar-button-paste my-tool-bar-function-paste
       :help (concat "Paste text "
                     (propertize "`yank'"
                                 'face 'font-lock-constant-face)))
      (fill
       menu-item ,my-tool-bar-button-fill my-tool-bar-function-fill
       :help (concat "Fill text in region to fit between left and right margin "
                     (propertize "`fill-region'"
                                 'face 'font-lock-constant-face)))
      (comment
       menu-item ,my-tool-bar-button-comment my-tool-bar-function-comment
       :help (concat "Comment text in region "
                     (propertize "`comment-or-uncomment-region'"
                                 'face 'font-lock-constant-face)))
      (play
       menu-item ,my-tool-bar-button-play my-tool-bar-function-play
       :help (concat "Run "
                     (propertize "`C-c'"
                                 'face 'font-lock-constant-face)))

      ;; (sep-2 menu-item ,(tab-bar-separator) ignore)
      ;; (sep-2 menu-item ,my-tool-bar-separator ignore
      ;;         :enable nil :help "")
      (sep-2 menu-item "  " ignore :enable nil :help "")

      (spell
       menu-item ,my-tool-bar-button-spell my-tool-bar-function-spell
       :help (concat "Spell checking "
                     (propertize "`flyspell-mode',`flyspell-buffer'"
                                 'face 'font-lock-constant-face)))
      (langtool
       menu-item ,my-tool-bar-button-langtool my-tool-bar-function-langtool
       :help (concat "LanguageTool "
                     (propertize "`langtool-check-buffer'"
                                 'face 'font-lock-constant-face)))
      (hide
       menu-item ,my-tool-bar-button-hide my-tool-bar-function-hide
       :help (concat "(Un)hide elements "
                     (propertize "`my-hide-elements'"
                                 'face 'font-lock-constant-face)))
      (read
       menu-item ,my-tool-bar-button-read my-tool-bar-function-read
       :help (concat "Read view "
                     (propertize "`my-distraction-free'"
                                 'face 'font-lock-constant-face)))
      
      (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 type order to load.
See `create-image' and `icons--create' and info node `(elisp) Image Descriptors' for the properties of an image."
  ;; (info "(elisp) Image Descriptors")
  
  ;; (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 (5 . 1)
               :ascent center)
        (text " "
              ;; :face tab-bar-tab-inactive
              ))
      "Separator."
      :version "29.1"))
  (setq my-tool-bar-separator (icon-string 'my-tool-bar-icon-separator))

  (unless (iconp 'my-tool-bar-icon-open)
    (define-icon my-tool-bar-icon-open nil
      `((image ;; "open.xpm"
               ;; "Fluent-dark/document-open.svg"
               "Fluent-dark/document-open-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (emoji "📂")
        (symbol "🗀 ")  ;; 🗁 🗀 
        (text "Opn "
              ;; :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-save)
    (define-icon my-tool-bar-icon-save nil
      `((image ;; "save.xpm"
               ;; "Fluent-dark/document-save.svg"
               "Fluent-dark/document-save-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (emoji "💾")
        (symbol "🖫 ")  ;; 🖪 🖫 🖬 
        (text "Sav "
              ;; :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-save-as)
    (define-icon my-tool-bar-icon-save-as nil
      `((image "Fluent-dark/document-save-as-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (text "SvA "
              ;; :face tab-bar-tab-inactive
              ))
      "Icon for save as."
      :version "29.1"))
  (setq my-tool-bar-button-save-as (icon-string 'my-tool-bar-icon-save-as))

  (unless (iconp 'my-tool-bar-icon-cancle)
    (define-icon my-tool-bar-icon-cancle nil
      `((image ;; "cancel.xpm"
               ;; "Fluent-dark/dialog-cancel.svg"
               "Fluent-dark/builder-build-stop-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (emoji "❌")
        (symbol "🗙 ")  ;; 🗙 𐌗
        (text "Qit "
              ;; :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-previous-buffer)
    (define-icon my-tool-bar-icon-previous-buffer nil
      `((image "Fluent-dark/go-previous-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "♺ ")  ; ⮔ ♺
        (text "PBf "
              ))
      "Icon for previous buffer."
      :version "29.1"))
  (setq my-tool-bar-button-previous-buffer (icon-string 'my-tool-bar-icon-previous-buffer))

  (unless (iconp 'my-tool-bar-icon-next-buffer)
    (define-icon my-tool-bar-icon-next-buffer nil
      `((image "Fluent-dark/go-next-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "♺ ")  ; ⮔ ♺
        (text "NBf "
              ))
      "Icon for next buffer."
      :version "29.1"))
  (setq my-tool-bar-button-next-buffer (icon-string 'my-tool-bar-icon-next-buffer))

  (unless (iconp 'my-tool-bar-icon-revert)
    (define-icon my-tool-bar-icon-revert nil
      `((image ;; "refresh.xpm"
               ;; "Fluent-dark/view-refresh.svg"
               "Fluent-dark/emblem-synchronizing-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "♺ ")  ; ⮔ ♺
        (text "Rev "
              ;; :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"
               ;; "Fluent-dark/edit-undo.svg"
               "Fluent-dark/edit-undo-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "↩ ")
        (text "UDo "
              ;; :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"
               ;; "Fluent-dark/edit-redo.svg"
               "Fluent-dark/edit-redo-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "↪ ")
        (text "RDo "
              ;; :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"
               ;; "Fluent-dark/edit-cut.svg"
               "Fluent-dark/edit-cut-symbolic.svg"
               :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"
               ;; "Fluent-dark/edit-copy.svg"
               "Fluent-dark/edit-copy-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "🗐 ")
        (text "Cpy "
              ;; :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"
               ;; "Fluent-dark/edit-paste.svg"
               "Fluent-dark/edit-paste-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (emoji "📋")
        (symbol "🗎 ")
        (text "Pst "
              ;; :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"
               ;; "Fluent-dark/format-text-direction-horizontal.svg"
               "Fluent-dark/format-justify-fill-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (symbol "≣ ")
        (text "Fil "
              ;; :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-comment)
    (define-icon my-tool-bar-icon-comment nil
      `((image "Fluent-dark/xapp-annotations-text-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (text "Com " ))
      "Icon for comment region."
      :version "29.1"))
  (setq my-tool-bar-button-comment (icon-string 'my-tool-bar-icon-comment))

  (unless (iconp 'my-tool-bar-icon-hide)
    (define-icon my-tool-bar-icon-hide nil
      `((image "Fluent-dark/display-no-filter-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center)
        (text "Hid " ))
      "Icon for (un)hide elements."
      :version "29.1"))
  (setq my-tool-bar-button-hide (icon-string 'my-tool-bar-icon-hide))

  (unless (iconp 'my-tool-bar-icon-spell)
    (define-icon my-tool-bar-icon-spell nil
      `((image ;; "spell.xpm"
               ;; "Fluent-dark/font-x-generic-symbolic.svg"
               "Fluent-dark/tools-check-spelling-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center
               )
        (symbol "⎁ ")  ;; ⎀ ⎁ ⎂
        (text "Spl "
              ;; :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"
               "LanguageTool.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center
               )
        (symbol "ℒ ")
        (text "Lng "
              ;; :face tab-bar-tab-inactive
              ))
      "Icon for languagetool."
      :version "29.1"))
  (setq my-tool-bar-button-langtool (icon-string 'my-tool-bar-icon-langtool))

  (unless (iconp 'my-tool-bar-icon-play)
    (define-icon my-tool-bar-icon-play nil
      `((image "Fluent-dark/builder-run-start-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center
               )
        (text "Run "
              ))
      "Icon for run C-c."
      :version "29.1"))
  (setq my-tool-bar-button-play (icon-string 'my-tool-bar-icon-play))

  (unless (iconp 'my-tool-bar-icon-read)
    (define-icon my-tool-bar-icon-read nil
      `((image "Fluent-dark/ephy-reader-mode-symbolic.svg"
               :height (1.5 . em)
               :margin ,tab-bar-button-margin
               :ascent center
               )
        (text "Rdv "
              ))
      "Icon for read view."
      :version "29.1"))
  (setq my-tool-bar-button-read (icon-string 'my-tool-bar-icon-read))

  )

(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