Add system.el

1 files changed, 113 insertions, 0 deletions

@@ -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