emacs/lisp/system.el

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