source: trunk/j/examples/init.lisp @ 5167

Last change on this file since 5167 was 5167, checked in by piso, 18 years ago

Work in progress.

File size: 4.1 KB
Line 
1;;; init.lisp
2;;; $Id: init.lisp,v 1.16 2003-12-17 00:10:57 piso Exp $
3
4;;; ~/.j/init.lisp (if it exists) is loaded automatically when j starts up.
5
6(defun load-theme (name)
7  (let ((filename (concatenate 'string "/home/peter/depot/j/themes/" name ".lisp")))
8    (unless (probe-file filename)
9      (error "file not found: ~A" filename))
10    (kill-theme)
11    (load filename)
12    (reset-display)
13    t))
14
15(defun hostname ()
16  (when (probe-file "/etc/hostname")
17    (with-open-file (f "/etc/hostname")
18      (read-line f))))
19
20;; Use Kodiak on prufrock, AnokhaClassic on the laptops.
21(let ((hostname (hostname)))
22  (if (and hostname (search "prufrock" hostname))
23      (load-theme "Kodiak")
24      (load-theme "AnokhaClassic")))
25
26(defun java-version ()
27  (jstatic "getProperty" "java.lang.System" "java.version"))
28
29(defun adjust-appearance ()
30  (when (member (subseq (java-version) 0 5) '("1.4.0" "1.4.1" "1.4.2") :test #'string=)
31    (set-global-property "adjustAscent" -2)
32    (set-global-property "adjustLeading" -2)
33    (reset-display)))
34
35;; Do it now!
36(adjust-appearance)
37
38;; Turn off the remove-trailing-whitespace preference for files in the
39;; directory ~/gcl/ansi-tests.
40(defun my-open-file-hook (buf)
41  (let ((filename (buffer-pathname buf)))
42    (when (and filename
43               (string= (directory-namestring filename)
44                        "/home/peter/gcl/ansi-tests/"))
45      (setf (variable-value 'remove-trailing-whitespace :buffer) nil))))
46
47(add-hook 'open-file-hook 'my-open-file-hook)
48
49;; Helper function for MY-BUFFER-ACTIVATED-HOOK.
50(defun sub-p (pathname dirname)
51  "Returns T if PATHNAME is in DIRNAME or one of its subdirectories"
52  (let ((dirname-length (length dirname)))
53    (and (> (length pathname) dirname-length)
54         (string= (subseq pathname 0 dirname-length) dirname))))
55
56(defun my-buffer-activated-hook (buf)
57  (let ((pathname (buffer-pathname buf)))
58    ;; PATHNAME might be NIL (not all buffers have associated files).
59    (when pathname
60      (let ((type (pathname-type pathname)))
61        ;; We only care about Lisp and Java buffers.
62        (when (member type '("lisp" "lsp" "cl" "java") :test 'string=)
63          (let ((tagpath
64                 (cond ((sub-p pathname "/home/peter/cmucl/src/")
65                        "/home/peter/cmucl/src/code:/home/peter/cmucl/src/compiler:/home/peter/cmucl/src/pcl")
66                       ((sub-p pathname "/home/peter/cl-bench/")
67                        "/home/peter/cl-bench:/home/peter/cl-bench/files:/home/peter/depot/j/src/org/armedbear/lisp")
68                       (t ; default case: no change
69                        nil))))
70            ;; If we end up here with a non-NIL TAGPATH, use it to set the
71            ;; buffer-specific value of the TAG-PATH preference for the current
72            ;; buffer.
73            (when tagpath
74              (setf (variable-value 'tag-path :buffer) tagpath))))))))
75
76;; Install our hook function.
77(add-hook 'buffer-activated-hook 'my-buffer-activated-hook)
78
79;; Call ADJUST-APPEARANCE after saving ~/.j/prefs.
80(defun my-after-save-hook (buf)
81  (let ((filename (buffer-pathname buf)))
82    (when (string= filename "/home/peter/.j/prefs")
83      (adjust-appearance))))
84
85(add-hook 'after-save-hook 'my-after-save-hook)
86
87(defun reset-incoming-filters ()
88  (jstatic "resetIncomingFilters" "org.armedbear.j.mail.IncomingFilter"))
89
90(defun add-incoming-filter (mailbox pattern action parameter)
91  (jstatic "addIncomingFilter" "org.armedbear.j.mail.IncomingFilter"
92           mailbox pattern action parameter))
93
94(add-hook 'mailbox-mode-hook
95          (lambda ()
96            (reset-incoming-filters)
97            (add-incoming-filter "inbox"
98                                 "~C linux-kernel"
99                                 "move"
100                                 "{annie}mail/linux-kernel")
101            (add-incoming-filter "inbox"
102                                 "~C ix.netcom.com"
103                                 "move"
104                                 "{annie}mail/netcom")))
105
106(when (probe-file "/home/peter/.j/key-pressed.lisp")
107  (load "/home/peter/.j/key-pressed.lisp"))
108
109(when (probe-file "/home/peter/.j/update-check-enabled.lisp")
110  (load "/home/peter/.j/update-check-enabled.lisp"))
Note: See TracBrowser for help on using the repository browser.