Mercurial > hg > xemacs

comparison pers-init.el @ 78:0abfe9bf83a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Thu, 25 Sep 2025 17:57:05 +0100
parents 32a75a4db17b
children
comparison
equal deleted inserted replaced
77:62fb1a21629a 78:0abfe9bf83a0
1 ;;; GNU Emacs init file for Henry Thompson
2 ;;; This part shared between all hosts
3 ;;; This part is my personal stuff, not for other incarnations
4 ;;; initialisation file for Emacs, that is, (l)emacs and epoch common
5 ;;; Last edited: Fri Sep 25 09:22:22 1992
6 ;;; Edit history since port: made load-path not site-dependant
7 ;;; split into common-init for all my incarnations and pers-init for private
8 ;;; added lemacs compatibility
9
10 ;;; HACK to deal with current x-crash workaround that I use a tty-launched
11 ;;; xemacs via gnuclient from an X environment
12 ;;; Not sure this is still needed 2023-10-07
13 (if (and (eq
14 (device-type (frame-device (get-frame-for-buffer (current-buffer))))
15 'x)
16 (not (getenv "DISPLAY")))
17 (progn (message "setting DISPLAY in env")
18 (setenv "DISPLAY" ":0")))
19
20 (setq user-full-name "Henry S. Thompson")
21
22 (setq vc-command-messages t)
23
24 (setq minibuffer-max-depth nil)
25 (defun run-kcl ()
26 "Run an inferior kcl process"
27 (interactive)
28 (switch-to-buffer (make-shell "kcl" "kcl"))
29 (inferior-lisp-mode))
30
31 (require 'mdn-extras)
32 (setq auto-mode-alist
33 (append '(("/perl/" . perl-mode)
34 ("\\.scm$" . scheme-mode)
35 ("\\.dsl$" . lisp-mode))
36 auto-mode-alist))
37 (setq inferior-lisp-program "scheme")
38 ;;; for scheme
39 (put 'letrec 'lisp-indent-function 1)
40 (put 'case 'lisp-indent-function 1)
41
42 (site-caseq (parc (nconc load-path '("/import/local/emacs/gnus-3.13/"))
43 (setq rmail-primary-inbox-list
44 '("~/mbox" "/net/piglet/usr/spool/mail/$USER"))))
45
46 (defun run-sicstus ()
47 "Run an inferior Prolog process, input and output via buffer *prolog*."
48 (interactive)
49 (if (not (boundp 'prolog-mode-map))
50 (let ((load-path (cons
51 (site-caseq (parc "/import/prolog-1.8/emacs")
52 (edin "??"))
53 load-path)))
54 (load "prolog" nil t)))
55 (require 'shell)
56 (switch-to-buffer (make-shell "prolog" (site-caseq (edin "sicstus")
57 (parc "prolog"))))
58 (inferior-prolog-mode))
59
60 (require 'hist)
61 (rplacd (assoc "*shell*" hk-pat-table)
62 "[a-z]+<[0-9]+>: ")
63
64 ;; turn off suspend-emacs -- use pause-emacs (^X.) instead
65 (global-unset-key "\C-Z")
66 (global-unset-key "\C-x\C-z")
67
68 (global-set-key "\C-xl" (function goto-line))
69
70 (require 'repl-comment)
71
72 (require 'compress)
73
74 (if (string-match "Lucid" emacs-version)
75 (progn
76 (require 'lemacs-compat)))
77
78 (if window-system
79 (progn
80 (add-hook 'sh-mode-hook '(lambda ()
81 (font-lock-mode 1)))
82 (add-hook 'perl-mode-hook '(lambda ()
83 (font-lock-mode 1)))
84 (add-hook 'emacs-lisp-mode-hook '(lambda ()
85 (font-lock-mode 1)))
86 (add-hook 'lisp-mode-hook '(lambda ()
87 (font-lock-mode 1)))
88 (add-hook 'sgml-mode-hook '(lambda ()
89 (if (not
90 (boundp 'sgml-font-lock-keywords))
91 (load "sgml-font-lock-keywords" t t))
92 (setq adaptive-fill-mode nil)
93 (font-lock-mode 1)
94 ))
95 (add-hook 'c-mode-hook '(lambda ()
96 (font-lock-mode 1)))
97 (add-hook 'c++-mode-hook '(lambda ()
98 (font-lock-mode 1)))
99 (add-hook 'scheme-mode-hook
100 '(lambda ()
101 (setq
102 scheme-font-lock-keywords
103 (if (or
104 (boundp 'lisp-font-lock-keywords)
105 (load "lisp-font-lock-keywords" t t))
106 lisp-font-lock-keywords))
107 (font-lock-mode 1)))
108 (add-hook 'python-mode-hook '(lambda ()
109 (font-lock-mode 1)))
110 (setq sgml-insert-missing-element-comment nil)
111 (load "psgml" nil t)
112 (load "psgml-edit" nil t)
113 ;; (load "xml-hack" nil t)
114 ; (setq sgml-catalog-files '("CATALOG" "f:/lib/sgml/catalog"))
115 (if (string-match "i386" (emacs-version))
116 (progn (defun win32-get-clipboard-data-cmd ()
117 (interactive)(insert (win32-get-clipboard-data)))
118 (global-set-key
119 "\C-x\C-y" 'win32-get-clipboard-data-cmd)))
120 ))
121
122
123 (site-caseq (edin
124 (setq sgml-catalog-files '("catalog" "/afs/inf.ed.ac.uk/user/h/ht/lib/sgml/catalog"))))
125
126 (if (string-match "Lucid" emacs-version)
127 ;; lemacs only goes here
128 (progn
129 (message "lem")
130 ;; DICE comes here 2012-01-13
131 (setq package-get-remove-copy nil)
132 (require 'mail-abbrevs)
133 (setq bbdb-north-american-phone-numbers-p nil)
134 (setq bbdb-use-pop-up nil)
135 (setq bbdb-complete-name-allow-cycling t
136 bbdb-completion-type 'primary-or-name)
137 (setq bbdb-quiet-about-name-mismatches t)
138 (setq bbdb-always-add-addresses t)
139 (setq bbdb-new-nets-always-primary t)
140 (site-caseq (edin
141 (setq bbdb-file "/disk/scratch/mail/.bbdb")))
142 (setq bbdb-hashtable-size 24203)
143 (require 'bbdb)
144 ;(require 'bbdb-rmail)
145 (require 'bbdb-com) ; to fix auto-fill
146 (setq mail-use-rfc822 nil)
147 (add-hook 'gnus-summary-mode-hook
148 (function (lambda ()
149 (make-local-variable 'mail-use-rfc822)
150 (setq mail-use-rfc822 t))))
151 (if (>= emacs-major-version 21)
152 (progn
153 (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
154 (add-hook 'gnus-startup-hook 'bbdb-insinuate-message)))
155 (fset 'bbdb-auto-fill-function (lambda () t)) ; ditto
156 (fmakunbound 'bbdb-orig-rmail-expunge)
157 ;(add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)
158 (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
159 (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)
160 (setq bbdb-dwim-net-address-allow-redundancy t)
161 (add-hook 'mail-setup-hook 'bbdb-define-all-aliases)
162 (add-hook 'gnus-message-setup-hook 'bbdb-define-all-aliases)
163 (if (not (fboundp 'define-mail-abbrev))
164 ;; fix a bug which crashes occasionally -- see also
165 ;; bbdb-com
166 (progn
167 (require 'sendmail)
168 ;(defadvice sendmail-pre-abbrev-expand-hook
169 ; (before bbdb-rebuilt-all-aliases activate)
170 ; (bbdb-rebuilt-all-aliases))
171 ))
172 (defun gnuserv-start-maybe ()
173 (if (not (frame-live-p gnuserv-frame))
174 (gnuserv-start)))
175 ;;; (require 'itimer)
176 ;;; (start-itimer "gsr" 'gnuserv-start-maybe
177 ;;; 1200 1200 nil nil)
178
179 (if window-system
180 (progn
181 (message "window-system-1")
182 ;; DICE comes here 2012-01-13
183 (require 'highlight-headers)
184 (defun rmail-fontify-headers ()
185 (highlight-headers (point-min) (point-max) t))
186 (add-hook 'rmail-show-message-hook 'rmail-fontify-headers)
187 (setq dired-mode-hook
188 '(lambda ()
189 (font-lock-mode 1)
190 (define-key dired-mode-map
191 [button2] '(lambda (click)
192 (interactive "e")
193 (mouse-set-point click)
194 (dired-advertised-find-file)))))
195 (set-face-background 'modeline '((x) . "lightgrey"))
196 (defun ht-rooms-setup (&optional arg)
197 (interactive)
198 (require 'rooms)
199 (require 'mail-extras)
200 (require 'diary)
201 (let ((scr (selected-frame)))
202 ; (sit-for 5)
203 (load "ht-rooms.config" nil t)
204 ;; for ecclerig viewed from paul
205 (if (eq (device-pixel-width (selected-device)) 1920)
206 (progn
207 (unwind-protect
208 (make-screen-for-room "diary" "+1219" "+68"))
209 (unwind-protect
210 (make-screen-for-room "elisp" "+1185" "+102"))
211 (unwind-protect
212 (make-screen-for-room "news" "+1253" "+34")))
213 ;; for ecclerig in office
214 (unwind-protect (make-screen-for-room "diary" "+1888" "+0"))
215 (unwind-protect (make-screen-for-room "elisp" "+1888" "+0"))
216 (unwind-protect (make-screen-for-room "news" "+1223" "+0")))
217 (sit-for 1)
218 (delete-frame scr))
219 (setq ht-default-config (current-window-configuration)))))
220 ;; DICE comes here 2012-01-13
221 (setq interprogram-paste-function (lambda ()
222 (or (get-clipboard-foreign)
223 (if (selection-exists-p)
224 (get-selection-foreign)))))
225 ;(load "device-type-hacking" t t)
226 (setq zmacs-regions t)
227 ;; override changed default, except in gnus
228 (message "dth")
229 (site-caseq (edin
230 (setq highlight-headers-follow-url-function
231 'browse-url-firefox
232 )
233 (setq browse-url-browser-function 'browse-url-firefox)
234 ))
235 (message "gnus-init")
236 (site-caseq ((edin markup maritain)
237 (require 'gnus-init)))
238 )
239 ;; vanilla v19 goes here
240 ;; probably stale/broken
241 (message "vanilla")
242 (if window-system
243 (progn
244 (message "window-system-2")
245 (defvar ht-frame-parameter-mods
246 '((auto-raise . t)
247 (auto-lower . nil)
248 (cursor-type . bar)))
249 (nconc
250 (site-caseq ((laptop maritain) (list '(height . 35)))
251 (t
252 (list
253 '(font .
254 "-adobe-courier-medium-r-normal--14-*"))))
255 ht-frame-parameter-mods
256 )
257 ;; if we have X, we have ISO-Latin-1, so
258 ;; set char codes 128--255 to display as themselves.
259 (require 'disp-table)
260 (standard-display-8bit 161 255)
261 ; (transient-mark-mode t)
262 ;; hightlight searching in bold
263 (setq search-highlight t)
264 (make-face 'isearch)
265 (copy-face 'bold 'isearch)
266 ; (set-face-underline-p 'region t)
267 ; (set-face-background 'region "white")
268 ; (set-face-foreground 'region "black")
269 ; (setq c++-font-lock-keywords 'undef)
270 ; (setq c-font-lock-keywords 'undef)
271 (modify-frame-parameters
272 nil
273 ht-frame-parameter-mods)
274 (setq default-frame-alist
275 (append
276 ht-frame-parameter-mods default-frame-alist))
277 ;; fix cut and paste
278 (setq interprogram-paste-function nil
279 interprogram-cut-function nil)
280 (defun ht-mouse-set-region (click) "set region and primary selection"
281 (interactive "e")
282 (mouse-set-region click)
283 (x-set-selection "PRIMARY" (buffer-substring (point)(mark))))
284 (defun ht-mouse-drag-region (click)
285 "drag region and set primary selection"
286 (interactive "e")
287 (mouse-drag-region click)
288 (if mark-active
289 (x-set-selection "PRIMARY" (buffer-substring (point)(mark)))))
290 (global-set-key [drag-mouse-1] (function ht-mouse-set-region))
291 (global-set-key [down-mouse-1] (function ht-mouse-drag-region))
292 (defun ht-mouse-insert-primary (click)
293 "set point and insert primary selection"
294 (interactive "e")
295 (mouse-set-point click)
296 (push-mark nil nil t)
297 (insert (x-selection)))
298 (global-set-key [mouse-2] (function ht-mouse-insert-primary))
299 (setq dired-mode-hook
300 '(lambda ()
301 (font-lock-mode 1)
302 (define-key dired-mode-map
303 [mouse-2] '(lambda (click)
304 (interactive "e")
305 (mouse-set-point click)
306 (dired-advertised-find-file)))))
307 (message "defined rooms 2")
308 )))
309 (setq sgml-insert-missing-element-comment nil)
310 (load "psgml" nil t)
311 (load "psgml-edit" nil t)
312 (load "xml-hack" nil t)
313 (add-hook 'sgml-mode-hook 'sgml-fix-para)
314 ;; v18 emacs only was here
315
316 (defun ht-rooms-resetup ()
317 (interactive)
318 (setq rooms-table nil)
319 (setq frames-table nil)
320 (ht-rooms-setup))
321
322 (defun sgml-fix-para ()
323 (setq paragraph-separate
324 "</[^>]*>\n\\([ \t]+\\| \\)")
325 (setq paragraph-start
326 "^[ \t]*</?[A-Za-z._-]+[ >]"))
327
328 (defun highlight-headers-ht-follow-url-netscape (url &optional arg)
329 (message "Sending URL to Netscape...")
330 (save-excursion
331 (set-buffer (get-buffer-create "*Shell Command Output*"))
332 (erase-buffer)
333 (if (equal 0 (call-process "netscape" nil t nil "-display" ":0.0"
334 "-remote"
335 (concat "openURL(" url ")")))
336 ;; it worked
337 nil
338 ;; it didn't work, so start a new Netscape process.
339 (call-process "netscape" nil 0 nil url)))
340 (message "Sending URL to Netscape... done"))
341
342 ;;; Moved from custom.el -- not customisable, I think. . .
343 (setq
344 ecb-options-version "2.27"
345 gnus-treat-display-smileys nil
346 gnus-treat-from-picon nil
347 gnus-treat-mail-picon nil
348 gnus-treat-newsgroups-picon nil
349 jde-enable-abbrev-mode t
350 package-get-require-signed-base-updates nil
351 pgg-passphrase-cache-expiry 36000
352 pui-package-install-dest-dir "/afs/inf.ed.ac.uk/user/h/ht/.xemacs/xemacs-packages"
353 efs-ftp-program-args '("-i" "-n" "-g" "-v")
354 efs-use-passive-mode t ; actually turns it _off_ !
355 )
356
357 (custom-set-faces
358 '(font-lock-builtin-face ((((type x mswindows)(class color)(background light))(:foreground "Purple"))(((type tty)(class color))(:foreground "magenta"))))
359 '(font-lock-comment-face ((((type x mswindows)(class color)(background light))(:foreground "blue4"))(((type tty)(class color))(:foreground "blue"))))
360 '(font-lock-constant-face ((((type x mswindows)(class color)(background light))(:foreground "CadetBlue"))(((type tty)(class color))(:foreground "cyan"))))
361 '(font-lock-doc-string-face ((((type x mswindows)(class color)(background light))(:foreground "green4"))(((type tty)(class color))(:foreground "green"))))
362 '(font-lock-function-name-face ((((type x mswindows)(class color)(background light))(:foreground "brown4"))(((type tty)(class color))(:foreground "cyan" :bold))))
363 '(font-lock-keyword-face ((((type x mswindows)(class color)(background light))(:foreground "red4"))(((type tty)(class color))(:foreground "red" :bold))))
364 '(font-lock-preprocessor-face ((((type x mswindows)(class color)(background light))(:foreground "blue3"))(((type tty)(class color))(:foreground "cyan" :bold))))
365 '(font-lock-reference-face ((((type x mswindows)(class color)(background light))(:foreground "red3"))(((type tty)(class color))(:foreground "red"))))
366 '(font-lock-string-face ((((type x mswindows)(class color)(background light))(:foreground "green4"))(((type tty)(class color))(:foreground "green" :bold))))
367 '(font-lock-type-face ((((type x mswindows)(class color)(background light))(:foreground "steelblue"))(((type tty)(class color))(:foreground "cyan" :bold))))
368 '(font-lock-variable-name-face ((((type x mswindows)(class color)(background light))(:foreground "magenta4"))(((type tty)(class color))(:foreground "magenta" :bold))))
369 '(font-lock-warning-face ((((type x mswindows)(class color)(background light))(:foreground "Red" :bold))(((type tty)(class color))(:foreground "red" :bold))))
370 )
371
372 (custom-set-faces
373 '(modeline (
374 (((type x mswindows)(class color))
375 (:foreground "black" :background "gray80"))
376 (t
377 (:foreground "black" :background "white"))))
378 '(modeline-buffer-id (
379 (((type x mswindows)(class color))
380 (:foreground "blue4" :background "gray80"))
381 (((type tty)(class color))
382 (:foreground "blue" :background "white"))
383 (t
384 (:foreground "black" :background "white" :bold t))))
385 '(modeline-mousable (
386 (((type x mswindows)(class color))
387 (:foreground "firebrick" :background "gray80"))
388 (((type tty)(class color))
389 (:foreground "red" :background "white"))
390 (t
391 (:foreground "black" :background "white"))))
392 '(modeline-mousable-minor-mode (
393 (((type x mswindows)(class color))
394 (:foreground "green4" :background "gray80"))
395 (((type tty)(class color))
396 (:foreground "green" :background "white" :bold t))
397 (t
398 (:foreground "black" :background "white"))))
399 )
400
401 (cd (user-home-directory))
402
403 (require 'misc) ; used to be in common-init...
404
405 (ht-custom-size)