Add system.el

2 files changed, 149 insertions, 15 deletions

@@ -52,41 +52,63 @@ See `no-littering' for examples.")
 (+define-dir sync/ (expand-file-name "~/Sync")
   "My Syncthing directory.")
 
+;; Load system-specific changes.
+(progn (require 'system)
+       (setq system-load-directory (sync/ "emacs/systems/" t))
+       (system-settings-load nil :nowarn))
+
 ;;; Default frame settings
 
 (setq default-frame-alist '((tool-bar-lines . 0)
-                                        (menu-bar-lines . 0)
-                                        (vertical-scroll-bars)
-                                        (horizontal-scroll-bars))
+                            (menu-bar-lines . 0)
+                            (vertical-scroll-bars)
+                            (horizontal-scroll-bars))
       frame-inhibit-implied-resize t
       frame-resize-pixelwise t
       window-resize-pixelwise t
       inhibit-x-resources t
       indicate-empty-lines nil
       indicate-buffer-boundaries '((top . right)
-                                                   (bottom . right)))
+                                   (bottom . right)))
+
+;;; Fonts
 
-;; Fonts
+;; Set default faces
 
-(let ((font-name "DejaVu  Sans Mono")
-      (font-size 105)
-      (variable-font-name "DejaVu Sans")
-      (variable-font-size 1.0))
-  (set-face-attribute 'default nil :family font-name
+(let ((font-name system-default-font)
+      (font-size system-default-height)
+      (variable-font-name system-variable-pitch-font)
+      (variable-font-size system-variable-pitch-height))
+  (set-face-attribute 'default nil :family system-default-font
                       :height font-size :weight 'book)
   (set-face-attribute 'italic nil :family font-name
                       :height font-size :slant 'italic)
   (set-face-attribute 'variable-pitch nil :family variable-font-name
                       :height variable-font-size))
 
+;; Emoji fonts
+
+(let ((ffl (font-family-list)))
+  (dolist (font '("Noto Color Emoji"
+                  "Noto Emoji"
+                  "Segoe UI Emoji"
+                  "Apple Color Emoji"
+                  "FreeSans"
+                  "FreeMono"
+                  "FreeSerif"
+                  "Unifont"
+                  "Symbola"))
+    (when (member font ffl)
+      (set-fontset-font t 'symbol (font-spec :family font) nil :append))))
+
 ;;; Packages
 
 (setq package-enable-at-startup nil
       package-quickstart nil
       straight-host-usernames '((github . "duckwork")
-                                                (gitlab .  "acdw"))
+                                (gitlab .  "acdw"))
       straight-check-for-modifications '(check-on-save
-                                                             find-when-checking))
+                                         find-when-checking))
 
 (setq no-littering-etc-directory .etc
       no-littering-var-directory .etc
@@ -117,8 +139,8 @@ See `no-littering' for examples.")
 (require 'straight-x)
 
 (dolist (pkg '(el-patch
-                   no-littering
-                   setup))
+               no-littering
+               setup))
   (straight-use-package pkg)
   (require pkg)
   (require (intern (format "+%s" pkg)) nil :noerror))
@@ -137,4 +159,3 @@ See `no-littering' for examples.")
 
 (provide 'early-init)
 ;;; early-init.el ends here
-
@@ -0,0 +1,113 @@
+;;; system.el --- System-specific configuration -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; When using Emacs on separate computers, some variables need different
+;; settings.  This library contains functions and variables to work with
+;; different system configurations for Emacs.
+
+;;; Code:
+
+(require 'cl-lib)
+
+(defgroup system nil
+  "System-specific configurations."
+  :group 'emacs
+  :prefix "system-")
+
+;;; Variables
+
+(defcustom system-load-alist '((system-microsoft-p . windows)
+                               (system-linux-p . linux))
+  "Alist describing which system Emacs is on.
+Each cell is of the form (PREDICATE . SYSTEM), where PREDICATE is
+a function of no arguments and SYSTEM is a string or symbol that
+will be passed to `system-settings-load'.
+
+This list need not be exhaustive; see `system-settings-load' for
+more details on what happens if this alist is exhausted."
+  :type '(alist :key-type function :value-type (choice string symbol)))
+
+(defcustom system-load-directory (locate-user-emacs-file "systems")
+  "The directory from which to load system-specific configurations."
+  :type 'file)
+
+;; `defcustoms' defined here are best-guess defaults.
+
+(defcustom system-default-font (pcase system-type
+                                      ((or 'ms-dos 'windows-nt)
+                                       "Consolas")
+                                      (_ "monospace"))
+  "The font used for the `default' face."
+  :type 'string)
+
+(defcustom system-default-height 100
+  "The height used for the `default' face."
+  :type 'number)
+
+(defcustom system-variable-pitch-font (pcase system-type
+                                        ((or 'ms-dos 'windows-nt)
+                                         "Arial")
+                                        (_ "sans-serif"))
+  "The font used for the `variable-pitch' face."
+  :type 'string)
+
+(defcustom system-variable-pitch-height 1.0
+  "The height used for the `variable-pitch' face.
+A floating-point number is recommended, since that makes it
+relative to the `default' face height."
+  :type 'number)
+
+;;; Functions
+
+;; Convenience functions for systems
+(defun system-microsoft-p ()
+  "Return non-nil if running in a Microsoft system."
+  (memq system-type '(ms-dos windows-nt)))
+
+(defun system-linux-p ()
+  "Return non-nil if running on a Linux system."
+  (memq system-type '(gnu/linux)))
+
+(defun system-warn (message &rest args)
+  "Display a wraning message made from (format-message MESSAGE ARGS...).
+This function is like `warn', except it uses the `system' type."
+  (display-warning 'system (apply #'format-message message args)))
+
+;;;###autoload
+(defun system-settings-load (&optional system error nomessage)
+  "Load system settings.
+If optional SYSTEM (a symbol or a string) is not provided, loop
+through `system-load-alist', testing the car of each cell there.
+When one matches, use the cdr of that cell as SYSTEM.  Either
+way, look in `system-load-directory' for the files to load.
+
+If none match, warn the user.
+
+Optional argument ERROR is similar to in `load', but negated: if
+t, it will generate an error; if nil, it will warn the user;
+otherwise, if ERROR is anything else, it will be completely
+silent.
+
+NOMESSAGE is passed as-is to `load'."
+  (let ((system (or system
+                    (cl-loop for (p . s) in system-load-alist
+                             if (funcall p)
+                             return s))))
+    (if system
+        (condition-case e
+            (load (expand-file-name (format "%s" system) system-load-directory)
+                  nil nomessage)
+          (t (cond ((eq error t) (signal (car e) (cdr e)))
+                   ((null error) (system-warn
+                                  (concat
+                                   "Couldn't find file `%s' to load"
+                                   " (Looked in %s).")
+                                  system system-load-directory)))))
+      (funcall (cond ((eq error t) #'error)
+                     ((null error) #'system-warn)
+                     (t #'ignore))
+               "Could not determine the system being used."))))
+
+(provide 'system)
+;;; system.el ends here