common-mode-line.el

;;; common-mode-line.el --- mode-line common for all windows.

;; Copyright (C) 2017 Constantin Kulikov
;;
;; Author: Constantin Kulikov (Bad_ptr) <[email protected]>
;; Version: 0.1
;; Package-Requires: ()
;; Date: 2017/01/24 16:22:13
;; License: GPL either version 3 or any later version
;; Keywords: frames, windows, mode-line, convenience
;; X-URL: https://gist.github.com/Bad-ptr/38c382c1e33cec1a08290105241d8ea3

;;; License:

;; This file is not part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; Draws a common per-frame mode-line.

;; Put this file into your load-path and the following into your ~/.emacs:
;;   (require 'common-mode-line)
;;   (common-mode-line-mode)

;;; Code:

(require 'cl)

(defgroup common-mode-line nil
  "Customize common-mode-line."
  :prefix "common-mode-line-"
  :group 'convenience
  :link '(url-link :tag "Github page"
                   "https://gist.github.com/Bad-ptr/38c382c1e33cec1a08290105241d8ea3"))

(defcustom common-mode-line-type nil
  "How to draw common-mode-line."
  :group 'common-mode-line
  :type '(choice
          (const :tag "Use ordinary window" :value nil)
          (const :tag "Use side window" :value side-window)))

(defcustom common-mode-line-window-side 'bottom
  "Side of the frame where mode-line will be displayed."
  :group 'common-mode-line
  :type '(choice
          (const :tag "At the bottom of the frame" :value bottom)
          (const :tag "At the top of the frame" :value top)))

(defcustom common-mode-line-window-slot
  (cond
   ((eq 'bottom common-mode-line-window-side) 1)
   (t -1))
  "Side window slot to use."
  :group 'common-mode-line
  :type '(choice
          (const   :tag "Middle slot" :value nil)
          (integer :tag "\n\
A value of zero means use the middle slot.\n\
 A negative value means use a slot\n\
  preceding (that is, above or on the left of) the middle slot.\n\
 A positive value means use a slot following (that is, below or\n\
  on the right of) the middle slot"
                   :value 0)))

(defvar common-mode-line--buffer nil
  "Buffer used to display mode-line.")

(defcustom common-mode-line-buffer-name " *common-mode-line*"
  "Name of the buffer used to display mode-line in it."
  :group 'common-mode-line
  :type 'string
  :set #'(lambda (sym val)
           (custom-set-default sym val)
           (when (buffer-live-p common-mode-line--buffer)
             (with-current-buffer common-mode-line--buffer
               (rename-buffer val)))))

(defvar common-mode-line--delayed-update-timer nil
  "Timer used to delay an update of the mode-line.")

(defcustom common-mode-line-update-delay 0.5
  "Time to delay an update of mode-line after last action."
  :group 'common-mode-line
  :type 'float)

(defvar common-mode-line--saved-emacs-mode-line-format
  (default-value 'mode-line-format)
  "Value of the mode-line-format before `common-mode-line-mode'
activation.")

(defvar common-mode-line--selected-window nil
  "Used to track current window.")

(unless (facep 'common-mode-line-face)
  (defface common-mode-line-face
    '((default :inherit mode-line))
    "Face for common mode-line.")
  (copy-face 'mode-line 'common-mode-line-face))

(defface common-mode-line-mode-line-active-face
  '((default :inherit mode-line :height 0.3))
  "Face for active window bottom border.")

(defface common-mode-line-mode-line-inactive-face
  '((default :inherit mode-line-inactive :height 0.3))
  "Face for inactive window bottom border.")

(defun common-mode-line--get-create-buffer ()
  (if (buffer-live-p common-mode-line--buffer)
      common-mode-line--buffer
    (setq common-mode-line--buffer
          (with-current-buffer (get-buffer-create
                                common-mode-line-buffer-name)
            (buffer-disable-undo)
            (setq-local mode-line-format nil)
            (setq-local header-line-format nil)
            (setq-local cursor-type nil)
            (setq-local cursor-in-non-selected-windows nil)
            (setq-local left-fringe-width 0)
            (setq-local right-fringe-width 0)
            (setq-local overflow-newline-into-fringe nil)
            (setq-local word-wrap nil)
            (setq-local show-trailing-whitespace nil)
            (toggle-truncate-lines 1)
            (current-buffer)))))

(defun common-mode-line--make-window (&optional frame)
  (let (win)
    (with-selected-frame (or frame (selected-frame))
      (setq win
            (if common-mode-line-type
                (display-buffer-in-side-window
                 buf `((side . ,common-mode-line-window-side)
                       (slot . ,common-mode-line-window-slot)
                       (window-height . 1)))
              (split-window (frame-root-window) nil
                            (if (eq 'bottom common-mode-line-window-side)
                                'below 'above)))))
    win))

(defun common-mode-line--create-window (&optional frame)
  (let* (window-configuration-change-hook
         (buf (common-mode-line--get-create-buffer))
         (win (common-mode-line--make-window frame)))
    (set-frame-parameter frame 'common-mode-line-window win)
    (with-selected-window win
      (with-current-buffer buf
        (set-window-buffer win buf)
        (set-window-dedicated-p win t)
        (set-window-parameter win 'no-other-window t)
        (set-window-parameter win 'common-mode-line-window t)
        (setq-local window-min-height 1)
        (setq-local window-safe-min-height 1)
        (setq-local window-size-fixed nil)
        (fit-window-to-buffer win 1 1)
        (when (fboundp 'window-preserve-size)
          (window-preserve-size win nil t))
        ;; (shrink-window-if-larger-than-buffer)
        (setq-local window-size-fixed t))
      )
    win))

(defun common-mode-line--get-create-window (&optional frame)
  (let ((win (frame-parameter frame 'common-mode-line-window)))
    (unless (window-live-p win)
      (setq win (window-with-parameter 'common-mode-line-window t frame)))
    (unless (window-live-p win)
      (setq win (common-mode-line--create-window frame)))
    win))

(defun common-mode-line--update ()
  (let* (window-configuration-change-hook
         (win (common-mode-line--get-create-window))
         (cwin (selected-window)))
    (unless (eq win cwin)
      (setq common-mode-line--selected-window
            (if (eq (minibuffer-window) cwin)
                (minibuffer-selected-window)
              cwin))
      (with-current-buffer (common-mode-line--get-create-buffer)
        (setq-local buffer-read-only nil)
        (erase-buffer)
        (let* ((ml-s (format-mode-line
                      (list "" '(eldoc-mode-line-string
                                 (" " eldoc-mode-line-string " "))
                            (default-value 'mode-line-format))
                      'common-mode-line-face
                      common-mode-line--selected-window))
               (win-w (window-width win))
               (fill-w (max 0 (- win-w (string-width ml-s)))))
          (insert
           (concat ml-s (propertize (make-string fill-w ?\ )
                                    'face 'common-mode-line-face))))
        (goto-char (point-min))
        (setq-local buffer-read-only t))
      ;; (with-selected-window win
      ;;   (let (window-size-fixed)
      ;;     (shrink-window-if-larger-than-buffer))
      ;;   )
      (setq mode-line-format ""))))

(defun common-mode-line--delayed-update (&rest args)
  (when common-mode-line-mode
    (unless (timerp common-mode-line--delayed-update-timer)
      (setq common-mode-line--delayed-update-timer
            (run-with-idle-timer
             common-mode-line-update-delay nil
             #'(lambda ()
                 (common-mode-line--update)
                 (setq common-mode-line--delayed-update-timer nil)))))))

(defun common-mode-line--activate (&optional frames)
  (add-to-list 'window-persistent-parameters
               '(common-mode-line-window . writable))
  (add-to-list 'window-persistent-parameters
               '(no-other-window . writable))
  (add-to-list 'face-remapping-alist
               '(mode-line common-mode-line-mode-line-active-face))
  (add-to-list 'face-remapping-alist
               '(mode-line-inactive common-mode-line-mode-line-inactive-face))
  (unless (listp frames) (setq frames (list frames)))
  (unless frames (setq frames
                       (delete-if #'(lambda (f) (or (not (frame-live-p f))
                                                    (and (daemonp)
                                                         (eq f terminal-frame))))
                                  (frame-list))))
  (dolist (frame frames)
    (common-mode-line--get-create-window frame))
  (setq common-mode-line--saved-emacs-mode-line-format
        (default-value 'mode-line-format)
        mode-line-format nil)
  (add-hook 'post-command-hook #'common-mode-line--delayed-update)
  (ad-activate #'force-mode-line-update))

(defun common-mode-line--deactivate (&optional frames)
  (when (timerp common-mode-line--delayed-update-timer)
    (cancel-timer common-mode-line--delayed-update-timer)
    (setq common-mode-line--delayed-update-timer nil))
  (unless (listp frames) (setq frames (list frames)))
  (let (all win)
    (unless frames
      (setq frames (frame-list)
            all t))
    (dolist (frame frames)
      (setq win (window-with-parameter 'common-mode-line-window))
      (when (window-live-p win)
        (set-window-dedicated-p win nil)
        (delete-window win))
      (set-frame-parameter frame 'common-mode-line-window nil))
    (unless (window-with-parameter 'common-mode-line-window t)
      (setq all t))
    (when all
      (setq face-remapping-alist
            (delq
             (assq 'mode-line
                   face-remapping-alist)
             face-remapping-alist))
      (setq face-remapping-alist
            (delq
             (assq 'mode-line-inactive
                   face-remapping-alist)
             face-remapping-alist))
      (dolist (w (window-list))
        (with-current-buffer (window-buffer w)
          (setq mode-line-format common-mode-line--saved-emacs-mode-line-format)))
      (kill-buffer (common-mode-line--get-create-buffer))
      (remove-hook 'post-command-hook #'common-mode-line--delayed-update)
      (ad-deactivate #'force-mode-line-update))))


(defadvice force-mode-line-update
    (after common-mode-line--delayed-update-adv)
  (common-mode-line--delayed-update)
  nil)


;;;###autoload
(define-minor-mode common-mode-line-mode
  "Toggle the common-mode-line-mode.
When active it draws a mode-line at the bottom(or top) of
the frame."
  :require 'common-mode-line-mode
  :group   'common-mode-line-mode
  :init-value nil
  :global     t
  ;; :lighter " cml"
  (if common-mode-line-mode
      (common-mode-line--activate)
    (common-mode-line--deactivate)))


(provide 'common-mode-line)

;;; common-mode-line.el ends here