Commit 0ab5e06c authored by Frank Terbeck's avatar Frank Terbeck

Move most GUI setup to ft-gui module

parent 953eca30
...@@ -124,99 +124,9 @@ ...@@ -124,99 +124,9 @@
;; Should work in terminal as well as in GUI emacs: ;; Should work in terminal as well as in GUI emacs:
(ft/map-key "C-M-u" universal-argument :states (normal)) (ft/map-key "C-M-u" universal-argument :states (normal))
(defun ft/multi-monitor-support-p () (w/function scroll-bar-mode (scroll-bar-mode -1))
(fboundp 'frame-monitor-attributes)) (w/function menu-bar-mode (menu-bar-mode -1))
(w/function tool-bar-mode (tool-bar-mode -1))
(defun ft/gui-display-width ()
(if (ft/multi-monitor-support-p)
(nth 3 (assq 'geometry (frame-monitor-attributes)))
(x-display-pixel-width)))
(defun ft/gui-display-height ()
(if (ft/multi-monitor-support-p)
(nth 4 (assq 'geometry (frame-monitor-attributes)))
(x-display-pixel-height)))
(defun ft/generate-font-string (system width height)
(let ((fmt (cond ((eq system 'ms-win) "Consolas-%d")
(t "DejaVu Sans Mono-%d")))
(embolden-p nil)
(size (cond ((eq system 'ms-win)
(cond ((> width 1400) 11)
(t 11)))
((eq system 'x-win)
(cond ((> width 2500) 14)
((> width 1400) 11)
(t 10)))
(t 12))))
(concat (format fmt size)
(if embolden-p ":embolden=true" ""))))
(defvar ft/gui-initialised nil
"Session variable reflecting if emacs' GUI parameters were initialised yet.")
(defmacro w/variable (name &rest code)
`(when (boundp (quote ,name))
,@code))
(defmacro w/function (name &rest code)
`(when (fboundp (quote ,name))
,@code))
(defun ft/set-gui-parameters ()
;; Configure GUI font based on system and screen size.
(let ((system (ft/host-system)))
(unless (member system ft/gui-initialised)
(when (member system '(x-win ms-win))
(w/variable default-frame-alist
(setq default-frame-alist
(let* ((width (ft/gui-display-width))
(height (ft/gui-display-height))
(gui-font (ft/generate-font-string system
width
height)))
(list (cons 'horizontal-scroll-bars nil)
(cons 'vertical-scroll-bars nil)
(cons 'font gui-font))))
(modify-frame-parameters nil default-frame-alist)))
;; Put yanked stuff into primary buffer, if we're on X11 since this will
;; not work on M$-Windoze type systems — and terminal emacs doesn't give
;; a crap anyway.
(w/variable select-enable-primary
(setq select-enable-primary t))
(w/variable select-enable-clipboard
(setq select-enable-clipboard nil))
(w/variable x-select-enable-clipboard-manager
(setq x-select-enable-clipboard-manager nil))
;; Mouse avoidance mode is interesting, but I only liked the ‘banish’ mode it
;; offers. Now after a while, I sometimes misclicked in another application
;; after switching to another workspace in my window manager.
(w/function mouse-avoidance-mode
(mouse-avoidance-mode 'none))
;; This is the default, but I wanted to remind myself that it exists.
;; Unfortuntely, it only makes the pointer invisible after *changing* a
;; buffer, and *not* if you merely move the cursor or scroll a buffer's
;; display. This is rather annoying for reading documentation within emacs.
;; Not great, but oh well.
;;
;; Update: There's https://github.com/jcs/xbanish which does pretty much
;; exactly what I want. Not in debian though... ...should I?
(w/variable make-pointer-invisible
(setq make-pointer-invisible t))
(setq ft/gui-initialised (cons system ft/gui-initialised)))))
(when (fboundp 'scroll-bar-mode) (scroll-bar-mode -1))
(when (fboundp 'menu-bar-mode) (menu-bar-mode -1))
(when (fboundp 'tool-bar-mode) (tool-bar-mode -1))
(add-hook 'server-after-make-frame-hook
(lambda ()
(ft/set-gui-parameters)
(winring-set-name "default")))
(setq-default line-spacing 0.1) (setq-default line-spacing 0.1)
(setq diff-switches '("-u")) (setq diff-switches '("-u"))
...@@ -244,9 +154,10 @@ ...@@ -244,9 +154,10 @@
(fset 'yes-or-no-p 'y-or-n-p) (fset 'yes-or-no-p 'y-or-n-p)
(column-number-mode t) (column-number-mode t)
(line-number-mode t)
(display-time-mode -1) (display-time-mode -1)
(global-font-lock-mode t) (global-font-lock-mode t)
(line-number-mode t)
(prefer-coding-system 'utf-8) (prefer-coding-system 'utf-8)
(unless ft/with-early-init-el (unless ft/with-early-init-el
...@@ -1050,6 +961,8 @@ It indents by four spaces and is otherwise similar to the BSD style.") ...@@ -1050,6 +961,8 @@ It indents by four spaces and is otherwise similar to the BSD style.")
(use-package ftblog (use-package ftblog
:commands ftblog/new-entry ftblog/meta-insert) :commands ftblog/new-entry ftblog/meta-insert)
(use-package ft-gui :config (ft/initialise-gui))
(use-package ft-space-key (use-package ft-space-key
:config :config
(ft/bind-space (list evil-normal-state-map (ft/bind-space (list evil-normal-state-map
...@@ -1623,12 +1536,12 @@ the file as PDF." ...@@ -1623,12 +1536,12 @@ the file as PDF."
(add-hook 'org-agenda-mode-hook (lambda () (hl-line-mode 1))) (add-hook 'org-agenda-mode-hook (lambda () (hl-line-mode 1)))
(ft/call-with-function (w/function 'org-babel-do-load-languages
'org-babel-do-load-languages (org-babel-do-load-languages 'org-babel-load-languages
(org-babel-do-load-languages 'org-babel-load-languages (mapcar (lambda (x)
(mapcar (lambda (x) (cons x t))
(cons x t)) '(emacs-lisp haskell
'(emacs-lisp haskell maxima octave))))) maxima octave)))))
(use-package ox-textile (use-package ox-textile
:load-path "vendor/ox-textile" :load-path "vendor/ox-textile"
......
(require 'winring)
(require 'ft-utilities)
(defvar ft/fallback-font-size 12
"Font size to use in case a more suitable size could not be
figured out.")
(defvar ft/default-frame-alist
'((horizontal-scroll-bars . nil)
(vertical-scroll-bars . nil))
"Partial value for `default-frame-alist'. Do not include a
`font' entry in here, as it will be added by the `ft-gui' module
instead.")
(defun ft/font-format (system)
"Return a default font format for a given SYSTEM.
The value returned is a string, usable by `format'. It should
contain exactly one \"%d\" that will be replaced by a font size
in `ft/generate-font-string'."
(cond ((eq system 'ms-win) "Consolas-%d")
('default-gui-font "DejaVu Sans Mono-%d")))
(defun ft/density-to-font-size (px)
"Map font sizes to minimum pixel densities."
(cond ((> px 8.0) 15)
((> px 7.0) 14)
((> px 6.0) 13)
((> px 4.5) 12)
((> px 3.5) 11)
((> px 2.0) 10)
(t ft/fallback-font-size)))
(defun ft/monitor-to-pixel-density (m)
"Return pixel density for a monitor parameter set M.
The parameter set can be retrieved by functions like
`frame-monitor-attributes' or `display-monitor-attributes'."
(let ((g (mapcar (lambda (x) (float (abs x)))
(cdddr (assq 'geometry m))))
(s (mapcar #'float (cdr (assq 'mm-size m)))))
(max (/ (car g) (car s))
(/ (cadr g) (cadr s)))))
(defun ft/max-pixel-density ()
"Return the maximum pixel density available to the system."
(apply #'max (mapcar #'ft/monitor-to-pixel-density
(display-monitor-attributes-list))))
(defun ft/pixel-density ()
"Return pixel density of the dominating monitor to an emacs
frame."
(ft/monitor-to-pixel-density (frame-monitor-attributes)))
(defun ft/generate-font-string (system)
"Generate font string for SYSTEM to use in a `font' spec.
It takes into account the system that is running emacs and the
pixel density of the dominating monitor that the focused emacs
frame is visible on."
(format (ft/font-format system)
(ft/density-to-font-size (ft/pixel-density))))
(defun ft/frame-parameters (system)
"Return frame parameter alist for SYSTEM."
(cons (cons 'font (ft/generate-font-string system))
ft/default-frame-alist))
(defun ft/set-gui-buffer-parameters ()
"Set GUI buffer handling parameters to something reasonable."
;; Put yanked stuff into primary buffer, if we're on X11 since this will
;; not work on M$-Windoze type systems — and terminal emacs doesn't give
;; a crap anyway.
(w/variable select-enable-primary
(setq select-enable-primary t))
(w/variable select-enable-clipboard
(setq select-enable-clipboard nil))
(w/variable x-select-enable-clipboard-manager
(setq x-select-enable-clipboard-manager nil)))
(defun ft/set-mouse-parameters ()
"Set GUI mouse handling parameters to something reasonable."
;; Mouse avoidance mode is interesting, but I only liked the ‘banish’
;; mode it offers. Now after a while, I sometimes misclicked in another
;; application after switching to another workspace in my window manager.
(w/function mouse-avoidance-mode
(mouse-avoidance-mode 'none))
;; This is the default, but I wanted to remind myself that it exists.
;; Unfortuntely, it only makes the pointer invisible after *changing* a
;; buffer, and *not* if you merely move the cursor or scroll a buffer's
;; display. This is rather annoying for reading documentation within
;; emacs. Not great, but oh well.
;;
;; Update: There's https://github.com/jcs/xbanish which does pretty much
;; exactly what I want. Not in debian though... ...should I?
(w/variable make-pointer-invisible
(setq make-pointer-invisible t)))
(defun ft/update-frame-parameters ()
(interactive)
(modify-frame-parameters nil (ft/frame-parameters (ft/host-system))))
(defun ft/frame-creation-hook ()
(ft/set-gui-buffer-parameters)
(ft/set-mouse-parameters)
(ft/update-frame-parameters)
(winring-set-name "default"))
(defun ft/gui-after-init-hook ()
(setq default-frame-alist (ft/frame-parameters (ft/host-system))))
(defun ft/initialise-gui ()
(add-hook 'after-init-hook #'ft/gui-after-init-hook)
(add-hook 'server-after-make-frame-hook #'ft/frame-creation-hook))
(provide 'ft-gui)
...@@ -6,35 +6,10 @@ ...@@ -6,35 +6,10 @@
;; Variables ;; ;; Variables ;;
;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;
(defvar ft/display
(getenv "DISPLAY")
"The $DISPLAY environment variable the current emacs instance was started in.")
(defvar ft/emacs-directory (defvar ft/emacs-directory
(expand-file-name "~/.emacs.d") (expand-file-name "~/.emacs.d")
"The $HOME/.emacs.d directory of the current system.") "The $HOME/.emacs.d directory of the current system.")
(defun ft/host-system ()
"Return the display-system the current emacs instance is running in. Can
be one of `console', `ms-win', `x-win', `mac', `dos' or `unknown'."
(cond
((eq window-system 'x) 'x-win)
((eq window-system nil) 'console)
((memq window-system '(win32 w32)) 'ms-win)
((eq window-system 'ns) 'mac)
((eq window-system 'pc) 'dos)
(t 'unknown)))
(defvar ft/host-name
(let ((name (system-name)))
(substring name 0 (string-match "\\." name)))
"Reflect the name of the host emacs is running on. Extract the
only the host-name if the `system-name' function returns a fqdn.")
(defvar ft/term
(or (getenv "TERM") "dumb")
"The $TERM environment variable the current emacs instance was started in.")
(defvar ft/gui-browser-function (defvar ft/gui-browser-function
nil nil
"If non-nil, make `ft/browse-url-gui' use this function instead "If non-nil, make `ft/browse-url-gui' use this function instead
...@@ -79,10 +54,30 @@ of a default browser, set within it.") ...@@ -79,10 +54,30 @@ of a default browser, set within it.")
;; Functions ;; ;; Functions ;;
;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;
(defun ft/message-characters-around-point () (defun ft/display ()
(message (format "before: %c, after %c" "Return the process's $DISPLAY environment variable."
(char-before (point)) (getenv "DISPLAY"))
(char-after (point)))))
(defun ft/host-name ()
"Reflect the name of the host emacs is running on. Extract the
only the host-name if the `system-name' function returns a fqdn."
(let ((name (system-name)))
(substring name 0 (string-match "\\." name))))
(defun ft/host-system ()
"Return the display-system the current emacs instance is running in. Can
be one of `console', `ms-win', `x-win', `mac', `dos' or `unknown'."
(cond
((eq window-system 'x) 'x-win)
((eq window-system nil) 'console)
((memq window-system '(win32 w32)) 'ms-win)
((eq window-system 'ns) 'mac)
((eq window-system 'pc) 'dos)
(t 'unknown)))
(defun ft/term ()
"Return the process's $TERM environment variable."
(or (getenv "TERM") "dumb"))
(defun ft/load-elisp-file (file) (defun ft/load-elisp-file (file)
"Load additional setup files, if they exist." "Load additional setup files, if they exist."
...@@ -116,15 +111,20 @@ of a default browser, set within it.") ...@@ -116,15 +111,20 @@ of a default browser, set within it.")
;; Macros ;; ;; Macros ;;
;;;;;;;;;;;; ;;;;;;;;;;;;
(defmacro ft/call-with-function (function code)
"Run `code' if `function' is available."
`(when (fboundp ,function)
,code))
(defmacro ft/register-to-hooks (fct list-of-hooks) (defmacro ft/register-to-hooks (fct list-of-hooks)
"Register a function `fct' to a number of hooks listed in `list-of-hooks'." "Register a function `fct' to a number of hooks listed in `list-of-hooks'."
`(mapc (lambda (hook) `(mapc (lambda (hook)
(add-hook hook ,fct)) (add-hook hook ,fct))
,list-of-hooks)) ,list-of-hooks))
(defmacro w/variable (name &rest code)
"Evaluate CODE if NAME is a bound variable."
`(when (boundp (quote ,name))
,@code))
(defmacro w/function (name &rest code)
"Evaluate CODE if NAME is a bound function."
`(when (fboundp (quote ,name))
,@code))
(provide 'ft-utilities) (provide 'ft-utilities)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment