Polish & move new modeline into :ui modeline

Removes modeline library out of core-ui and contains them in :ui
doom-modeline and :ui modeline.

:ui modeline will eventually replace :ui doom-modeline, but is still
considered experimental. This update provides makes it much more stable
and closer to being feature complete.
This commit is contained in:
Henrik Lissner 2018-07-29 02:50:16 +02:00
parent db8ed4aac6
commit 088480047c
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
10 changed files with 1429 additions and 1272 deletions

View file

@ -0,0 +1,19 @@
;;; ui/modeline/autoload/modeline.el -*- lexical-binding: t; -*-
;; (defvar +modeline--old-bar-height nil)
;; ;;;###autoload
;; (defun +modeline|resize-for-big-font ()
;; "Adjust the modeline's height when `doom-big-font-mode' is enabled. This was
;; made to be added to `doom-big-font-mode-hook'."
;; (unless +modeline--old-bar-height
;; (setq +modeline--old-bar-height +doom-modeline-height))
;; (let ((default-height +modeline--old-bar-height))
;; (if doom-big-font-mode
;; (let* ((font-size (font-get doom-font :size))
;; (big-size (font-get doom-big-font :size))
;; (ratio (/ (float big-size) font-size)))
;; (setq +doom-modeline-height (ceiling (* default-height ratio 0.75))))
;; (setq +doom-modeline-height default-height))
;; ;; already has a variable watcher in Emacs 26+
;; (unless EMACS26+ (+doom-modeline|refresh-bars))))

View file

@ -0,0 +1,92 @@
;;; ui/modeline/autoload/settings.el -*- lexical-binding: t; -*-
(defvar +modeline--alist nil)
;;;###autodef
(defun def-modeline-format! (name left &optional right)
"Define a preset modeline format by name.
NAME is a symbol. The convention is to use keywords for global formats, like
:main or :project, but to use regular symbols for buffer-local formats, like
'twitter and 'pdf.
LEFT and RIGHT are lists that assume the same structure as `mode-line-format',
and make up the mode-line in two parts, separated by variable-width space, to
keep them left and right aligned respectively."
(setf (alist-get name +modeline--alist) (list left right)))
;;;###autodef
(defmacro def-modeline-segment! (name &rest rest)
"TODO"
(declare (doc-string 2))
(let ((docstring (if (and (stringp (car rest)) (cdr rest)) (pop rest)))
body)
(macroexp-progn
(if (not (keywordp (car rest)))
`((defvar-local ,name nil ,docstring)
(setq-default
,name
,(if (or (stringp (car rest))
(memq (car (car-safe rest)) '(:eval :propertize)))
(car rest)
`(quote (:eval ,(macroexp-progn rest)))))
(put ',name 'risky-local-variable t))
;; isolate body
(setq body rest)
(while (keywordp (car body))
(setq body (cddr body)))
;;
(cl-destructuring-bind (&key init faces on-hooks on-set activate deactivate &allow-other-keys)
rest
(let ((realvar (if (and body faces)
(intern (format "+modeline--var-%s" name))
name)))
(append (when body
(if (or on-hooks on-set)
(let ((setterfn (intern (format "+modeline--set-%s" name)))
(varsetterfn (intern (format "+modeline--setvar-%s" name))))
(append `((fset ',setterfn
(lambda (&rest _)
(when (or (memq ',name +modeline-format-left)
(memq ',name +modeline-format-right))
(setq-local ,realvar ,(macroexp-progn body)))))
(byte-compile ',setterfn))
(mapcar (lambda (hook) `(add-hook ',hook #',setterfn))
on-hooks)
(when on-set
`((fset ',varsetterfn
(lambda (sym val op where)
(and (eq op 'set) where
(with-current-buffer where
(set sym val)
(,setterfn)))))
,@(mapcar (lambda (var) `(add-variable-watcher ',var #',varsetterfn))
on-set)))))
(setq init `(quote (:eval ,(macroexp-progn body))))
nil))
(if (eq realvar name)
`((defvar-local ,name nil ,docstring)
(setq-default ,name ,init))
`((defvar-local ,realvar nil)
(defvar-local ,name nil ,docstring)
(setq-default
,name '(:eval (cond ((active) ,realvar)
(,realvar (substring-no-properties ,realvar)))))))
`((put ',name 'risky-local-variable t)))))))))
;;;###autodef
(defun set-modeline! (name &optional default)
"Replace the current buffer's modeline with a preset mode-line format defined
with `def-modeline-format!'.
If DEFAULT is non-nil, make it the default mode-line for all buffers."
(cl-check-type name symbol)
(let ((modeline (cdr (assq name +modeline--alist))))
(unless modeline
(error "The %s modeline format does not exist" name))
(if default
(setq-default +modeline-format-left `("" ,@(car modeline))
+modeline-format-right `("" ,@(cadr modeline)))
(setq +modeline-format-left `("" ,@(car modeline))
+modeline-format-right `("" ,@(cadr modeline))))
(force-mode-line-update)))