1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
;;; 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)
(defvar system-system nil
"The current system's symbol.
Do not edit this by hand. Instead, call `system-get-system'.")
(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'.")
;;; 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)))
(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))
;;;###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.
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.
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)))
(provide 'system)
;;; system.el ends here
|
