summary refs log tree commit diff stats
path: root/lisp/system.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/system.el')
-rw-r--r--lisp/system.el179
1 files changed, 0 insertions, 179 deletions
diff --git a/lisp/system.el b/lisp/system.el deleted file mode 100644 index 73cd80b..0000000 --- a/lisp/system.el +++ /dev/null
@@ -1,179 +0,0 @@
1;;; system.el --- Load system-dependendant settings -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; When using Emacs on multiple computers, some variables and functions need
6;; different definitions. This library is built to assist in working with
7;; different system configurations for Emacs.
8
9;;; TODO:
10
11;; machine.el
12;; machine-case to switch on machine
13;;
14
15;;; Code:
16
17(require 'cl-lib)
18
19(defgroup system nil
20 "System-specific configurations."
21 :group 'emacs
22 :prefix "system-")
23
24;;; Settings
25
26(defcustom system-load-directory (locate-user-emacs-file "systems"
27 "~/.emacs-systems")
28 "The directory where system-specific configurations live."
29 :type 'file)
30
31;; These `defcustom's are best-guess defaults.
32
33(defcustom system-default-font (cond
34 ((memq system-type '(ms-dos windows-nt))
35 "Consolas")
36 (t "monospace"))
37 "The font used for the `default' face.
38Set this in your system files."
39 :type 'string)
40
41(defcustom system-default-height 100
42 "The height used for the `default' face.
43Set this in your system files."
44 :type 'number)
45
46(defcustom system-variable-pitch-font (cond
47 ((memq system-type '(ms-dos windows-nt))
48 "Arial")
49 (t "sans-serif"))
50 "The font used for the `variable-pitch' face.
51Set this in your system files."
52 :type 'string)
53
54(defcustom system-variable-pitch-height 1.0
55 "The height used for the `variable-pitch' face.
56A floating-point number is recommended, since that makes it
57relative to the `default' face height.
58
59Set this in your system files."
60 :type 'number)
61
62(defcustom system-files-order '(:type :name :user)
63 "The order to load `system-files' in.
64The elements of this list correspond to the keys in
65`system-system'."
66 :type '(list (const :tag "System type" :type)
67 (const :tag "System name" :name)
68 (const :tag "Current user" :user)))
69
70;;; Variables
71
72(defvar system-system nil
73 "Plist of systems that Emacs is in.
74The keys are as follows:
75
76- :name - `system-name'
77- :type - `system-type'
78- :user - `user-login-name'
79
80Each value is made safe to be a file name by passing through
81`system--safe'.
82
83Do not edit this by hand. Instead, call `system-get-systems'.")
84
85(defvar system-files nil
86 "List of files to load for system-specific configuration.
87Do not edit this by hand. Instead, call `system-get-system-files'.")
88
89
90;;; Functions
91
92(defun system--warn (message &rest args)
93 "Display a system-file warning message.
94This function is like `warn', except it uses a `system' type."
95 (display-warning 'system (apply #'format-message message args)))
96
97(defun system--safe (str)
98 "Make STR safe for a file name."
99 (let ((bad-char-regexp ))
100 (downcase (string-trim
101 (replace-regexp-in-string "[#%&{}\$!'\":@<>*?/ \r\n\t+`|=]+"
102 "-" str)
103 "-" "-"))))
104
105(defun system-get-systems ()
106 "Determine the current system(s).
107This system updates `system-system', which see."
108 ;; Add system-name
109 (setf (plist-get system-system :name)
110 (intern (system--safe (system-name))))
111 ;; Add system-type
112 (setf (plist-get system-system :type)
113 (intern (system--safe (symbol-name system-type))))
114 ;; Add current user
115 (setf (plist-get system-system :user)
116 ;; Use `user-real-login-name' in case Emacs gets called under su.
117 (intern (system--safe (user-real-login-name))))
118 system-system)
119
120(defun system-get-files ()
121 "Determine the current systems' load-files.
122The system load-files should live in `system-load-directory', and
123named using either the raw name given by the values of
124`system-system', or that name prepended with the type, e.g.,
125\"name-bob.el\", for a system named \"bob\".
126
127The second form of file-name is to work around name collisions,
128e.g. if a there's a user named \"bob\" and a system named
129\"bob\".
130
131This function updates `system-files'."
132 ;; Get systems
133 (system-get-systems)
134 ;; Re-set `system-files'
135 (setq system-files nil)
136
137 (let (ret)
138 (dolist (key (reverse system-files-order))
139 (let* ((val (plist-get system-system key))
140 (key-val (intern (system--safe (format "%s-%s" key val)))))
141 (push (list key-val val) ret)))
142
143 ;; Update `system-files'.
144 (setq system-files ret)))
145
146;;;###autoload
147(defun system-settings-load (&optional error nomessage)
148 "Load system settings from `system-files'.
149Each list in `system-files' will be considered item-by-item; the
150first found file in each will be loaded.
151
152ERROR determines how to deal with errors: if nil, warn the user
153when no system-files can be found or when the system being used
154cannot be determined. If t, these warnings are elevated to
155errors. Any other value ignores the warnings completely.
156
157NOMESSAGE is passed directly to `load'."
158 (system-get-files)
159 (if system-files
160 (let (files-loaded)
161 (dolist (ss system-files)
162 (catch :done
163 (dolist (s ss)
164 (let ((fn (expand-file-name (format "%s" s)
165 system-load-directory)))
166 (when (load fn t nomessage)
167 (push fn files-loaded)
168 (throw :done nil))))))
169 (unless files-loaded
170 (cond ((eq error t) (error "Error loading system-files.")
171 (null error) (system--warn "Couldn't load system-files."))))
172 files-loaded)
173 (funcall (cond ((eq error t) #'error)
174 ((null error) #'system--warn)
175 (t #'ignore))
176 "Couldn't determine the system being used.")))
177
178(provide 'system)
179;;; system.el ends here