So! Many! Changes!!

1 files changed, 128 insertions, 112 deletions

@@ -1,9 +1,9 @@
-;;; system.el --- System-specific configuration -*- lexical-binding: t; -*-
+;;; system.el --- Load system-dependendant settings -*- lexical-binding: t; -*-
 
 ;;; Commentary:
 
-;; When using Emacs on separate computers, some variables need different
-;; settings.  This library contains functions and variables to work with
+;; 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.
 
 ;;; Code:
@@ -15,145 +15,161 @@
   :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'.
+;;; Settings
 
-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."
+(defcustom system-load-directory (locate-user-emacs-file "systems"
+                                                         "~/.emacs-systems")
+  "The directory where system-specific configurations live."
   :type 'file)
 
-;; `defcustoms' defined here are best-guess defaults.
+;; These `defcustom's 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."
+(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."
+  "The height used for the `default' face.
+Set this in your system files."
   :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."
+(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."
+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
-  "The current system's symbol.
-Do not edit this by hand.  Instead, call `system-get-system'.")
+  "Plist of systems that Emacs is in.
+The keys are as follows:
 
-(defvar system-file nil
-  "The current system's file for system-specific configuration.
-Do not edit this by hand.  Instead, call `system-get-system-file'.")
+- :name - `system-name'
+- :type - `system-type'
+- :user - `user-login-name'
 
-;;; Functions
+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'.")
 
-;; Convenience functions for systems
-(defun system-microsoft-p ()
-  "Return non-nil if running in a Microsoft system."
-  (memq system-type '(ms-dos windows-nt)))
+(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'.")
 
-(defun system-linux-p ()
-  "Return non-nil if running on a Linux system."
-  (memq system-type '(gnu/linux)))
+
+;;; Functions
 
-(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."
+(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-get-system ()
-  "Determine the current system."
-  (cl-loop for (p . s) in system-load-alist
-           if (with-demoted-errors (format "Problem running function `%s'" p)
-                (funcall p))
-           return (setq system-system s)))
-
-(defun system-get-system-file (&optional system refresh-cache set-system-file-p)
-  "Determine the current system's system-specific file.
-The current system's file will be returned.  The value of
-`system-file' is set, /unless/ the parameter SYSTEM was passed to
-this function and SET-SYSTEM-FILE-P is nil.  If both SYSTEM and
-SET-SYSTEM-FILE-P are non-nil, this function will still set
-`system-file'.
-
-If SYSTEM is not passed, and `system-file' is set, simply return
-its value /unless/ REFRESH-CACHE is non-nil, in which case
-`system-load-alist' will be looped through to find the
-appropriate system by testing the car of each cell there.  When
-one matches, use the cdr of that cell as SYSTEM.  If none
-matches, return nil.
-
-This function will only look for system-specific files in
-`system-load-directory'."
-  (let* ((system* (or system
-                     (and system-file (not refresh-cache))
-                     (system-get-system)))
-        (file (expand-file-name (format "%s" system*) system-load-directory)))
-    (when (or (not system)
-              (and system set-system-file-p))
-      (setq system-file file))
-    file))
+(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 system error nomessage)
-  "Load system settings.
-Load settings from `system-file', or the `system-file' as
-determined by SYSTEM, if passed.  See `system-get-system-file' for
-details on how the `system-file' is determined.
+(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 `system-file' can't be found or when the system being used
-can't be determined.  If t, those are elevated to errors.  If any
-other value, the errors are completely ignored.
+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'."
-  (let ((file (system-get-system-file system)))
-    (if file
-        (condition-case e
-            (load file nil nomessage)
-          (t (cond ((eq error t) (signal (car e) (cdr e)))
-                   ((null error) (system-warn "Couldn't find file `%s'."
-                                              file)))))
-      (funcall (cond ((eq error t) #'error)
-                     ((null error) #'system-warn)
-                     (t #'ignore))
-               "Could not determine the system being used."))))
-
-;;;###autoload
-(defun system-find-system-file (&optional system)
-  "Find the current system's system-file."
-  (interactive (list (completing-read "System file: "
-                                      (mapcar (lambda (a) (format "%s" (cdr a)))
-                                              system-load-alist)
-                                      nil t nil nil
-                                      (format "%s" (system-get-system)))))
-  (find-file (cl-loop with file = (system-get-system-file system)
-                      for cand in (list file
-                                        (concat file ".el"))
-                      if (file-exists-p cand)
-                      return cand
-                      finally return cand)))
+  (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
+
+