180 lines
5.7 KiB
EmacsLisp
180 lines
5.7 KiB
EmacsLisp
;;; system.el --- Load system-dependendant settings -*- lexical-binding: t; -*-
|
||
|
||
;;; Commentary:
|
||
|
||
;; When using Emacs on multiple computers, some variables and functions need
|
||
;; different definitions. This library is built to assist in working with
|
||
;; different system configurations for Emacs.
|
||
|
||
;;; TODO:
|
||
|
||
;; machine.el
|
||
;; machine-case to switch on machine
|
||
;;
|
||
|
||
;;; Code:
|
||
|
||
(require 'cl-lib)
|
||
|
||
(defgroup system nil
|
||
"System-specific configurations."
|
||
:group 'emacs
|
||
:prefix "system-")
|
||
|
||
;;; Settings
|
||
|
||
(defcustom system-load-directory (locate-user-emacs-file "systems"
|
||
"~/.emacs-systems")
|
||
"The directory where system-specific configurations live."
|
||
:type 'file)
|
||
|
||
;; These `defcustom's are best-guess defaults.
|
||
|
||
(defcustom system-default-font (cond
|
||
((memq system-type '(ms-dos windows-nt))
|
||
"Consolas")
|
||
(t "monospace"))
|
||
"The font used for the `default' face.
|
||
Set this in your system files."
|
||
:type 'string)
|
||
|
||
(defcustom system-default-height 100
|
||
"The height used for the `default' face.
|
||
Set this in your system files."
|
||
:type 'number)
|
||
|
||
(defcustom system-variable-pitch-font (cond
|
||
((memq system-type '(ms-dos windows-nt))
|
||
"Arial")
|
||
(t "sans-serif"))
|
||
"The font used for the `variable-pitch' face.
|
||
Set this in your system files."
|
||
: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.
|
||
|
||
Set this in your system files."
|
||
:type 'number)
|
||
|
||
(defcustom system-files-order '(:type :name :user)
|
||
"The order to load `system-files' in.
|
||
The elements of this list correspond to the keys in
|
||
`system-system'."
|
||
:type '(list (const :tag "System type" :type)
|
||
(const :tag "System name" :name)
|
||
(const :tag "Current user" :user)))
|
||
|
||
;;; Variables
|
||
|
||
(defvar system-system nil
|
||
"Plist of systems that Emacs is in.
|
||
The keys are as follows:
|
||
|
||
- :name - `system-name'
|
||
- :type - `system-type'
|
||
- :user - `user-login-name'
|
||
|
||
Each value is made safe to be a file name by passing through
|
||
`system--safe'.
|
||
|
||
Do not edit this by hand. Instead, call `system-get-systems'.")
|
||
|
||
(defvar system-files nil
|
||
"List of files to load for system-specific configuration.
|
||
Do not edit this by hand. Instead, call `system-get-system-files'.")
|
||
|
||
|
||
;;; Functions
|
||
|
||
(defun system--warn (message &rest args)
|
||
"Display a system-file warning message.
|
||
This function is like `warn', except it uses a `system' type."
|
||
(display-warning 'system (apply #'format-message message args)))
|
||
|
||
(defun system--safe (str)
|
||
"Make STR safe for a file name."
|
||
(let ((bad-char-regexp ))
|
||
(downcase (string-trim
|
||
(replace-regexp-in-string "[#%&{}\$!'\":@<>*?/ \r\n\t+`|=]+"
|
||
"-" str)
|
||
"-" "-"))))
|
||
|
||
(defun system-get-systems ()
|
||
"Determine the current system(s).
|
||
This system updates `system-system', which see."
|
||
;; Add system-name
|
||
(setf (plist-get system-system :name)
|
||
(intern (system--safe (system-name))))
|
||
;; Add system-type
|
||
(setf (plist-get system-system :type)
|
||
(intern (system--safe (symbol-name system-type))))
|
||
;; Add current user
|
||
(setf (plist-get system-system :user)
|
||
;; Use `user-real-login-name' in case Emacs gets called under su.
|
||
(intern (system--safe (user-real-login-name))))
|
||
system-system)
|
||
|
||
(defun system-get-files ()
|
||
"Determine the current systems' load-files.
|
||
The system load-files should live in `system-load-directory', and
|
||
named using either the raw name given by the values of
|
||
`system-system', or that name prepended with the type, e.g.,
|
||
\"name-bob.el\", for a system named \"bob\".
|
||
|
||
The second form of file-name is to work around name collisions,
|
||
e.g. if a there's a user named \"bob\" and a system named
|
||
\"bob\".
|
||
|
||
This function updates `system-files'."
|
||
;; Get systems
|
||
(system-get-systems)
|
||
;; Re-set `system-files'
|
||
(setq system-files nil)
|
||
|
||
(let (ret)
|
||
(dolist (key (reverse system-files-order))
|
||
(let* ((val (plist-get system-system key))
|
||
(key-val (intern (system--safe (format "%s-%s" key val)))))
|
||
(push (list key-val val) ret)))
|
||
|
||
;; Update `system-files'.
|
||
(setq system-files ret)))
|
||
|
||
;;;###autoload
|
||
(defun system-settings-load (&optional error nomessage)
|
||
"Load system settings from `system-files'.
|
||
Each list in `system-files' will be considered item-by-item; the
|
||
first found file in each will be loaded.
|
||
|
||
ERROR determines how to deal with errors: if nil, warn the user
|
||
when no system-files can be found or when the system being used
|
||
cannot be determined. If t, these warnings are elevated to
|
||
errors. Any other value ignores the warnings completely.
|
||
|
||
NOMESSAGE is passed directly to `load'."
|
||
(system-get-files)
|
||
(if system-files
|
||
(let (files-loaded)
|
||
(dolist (ss system-files)
|
||
(catch :done
|
||
(dolist (s ss)
|
||
(let ((fn (expand-file-name (format "%s" s)
|
||
system-load-directory)))
|
||
(when (load fn t nomessage)
|
||
(push fn files-loaded)
|
||
(throw :done nil))))))
|
||
(unless files-loaded
|
||
(cond ((eq error t) (error "Error loading system-files.")
|
||
(null error) (system--warn "Couldn't load system-files."))))
|
||
files-loaded)
|
||
(funcall (cond ((eq error t) #'error)
|
||
((null error) #'system--warn)
|
||
(t #'ignore))
|
||
"Couldn't determine the system being used.")))
|
||
|
||
(provide 'system)
|
||
;;; system.el ends here
|