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

Last change on this file since 8338 was 8338, checked in by piso, 17 years ago

ADJUST-APPEARANCE: don't do anything on Windows.

File size: 4.9 KB
Line 
1;;; init.lisp
2;;; $Id: init.lisp,v 1.28 2005-01-11 04:20:41 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(let ((hostname (hostname)))
21  (when hostname
22    (unless (member hostname '("mars" "prufrock") :test #'string=)
23      (load-theme "AnokhaClassic"))))
24
25(defun java-version ()
26  (jstatic "getProperty" "java.lang.System" "java.version"))
27
28(defun adjust-appearance ()
29  (unless (sys:featurep :windows)
30    (when (member (subseq (java-version) 0 5)
31                  '("1.4.0" "1.4.1" "1.4.2" "1.5.0")
32                  :test #'string=)
33      (set-global-property "adjustAscent" -2)
34      (set-global-property "adjustLeading" -2)
35      (reset-display))))
36
37;; Do it now!
38(adjust-appearance)
39
40;; Turn off the remove-trailing-whitespace preference for files in the
41;; directory ~/gcl/ansi-tests.
42(defun my-open-file-hook (buf)
43  (let ((pathname (buffer-pathname buf)))
44    (when (and pathname
45               (string= (directory-namestring pathname)
46                        "/home/peter/gcl/ansi-tests/"))
47      (setf (variable-value 'remove-trailing-whitespace :buffer) nil))))
48
49(add-hook 'open-file-hook 'my-open-file-hook)
50
51;; Helper function for MY-BUFFER-ACTIVATED-HOOK.
52(defun sub-p (namestring dirname)
53  "Returns T if NAMESTRING is in DIRNAME or one of its subdirectories"
54  (let ((dirname-length (length dirname)))
55    (and (> (length namestring) dirname-length)
56         (string= (subseq namestring 0 dirname-length) dirname))))
57
58(defun my-buffer-activated-hook (buf)
59  (let ((pathname (buffer-pathname buf)))
60    ;; PATHNAME might be NIL (not all buffers have associated files).
61    (when pathname
62      (let ((type (pathname-type pathname)))
63        ;; We only care about Lisp and Java buffers.
64        (cond ((string= type "el")
65               (setf (variable-value 'tag-path :buffer)
66                     "/home/peter/emacs-21.3/lisp:/home/peter/emacs-21.3/lisp/emacs-lisp"))
67              ((member type '("lisp" "lsp" "cl" "java") :test 'string=)
68               (let* ((namestring (namestring pathname))
69                      (tagpath
70                       (cond ((sub-p namestring "/home/peter/cmucl/src/")
71                              "/home/peter/cmucl/src/code:/home/peter/cmucl/src/compiler:/home/peter/cmucl/src/pcl")
72                             ((sub-p namestring "/home/peter/cl-bench/")
73                              "/home/peter/cl-bench:/home/peter/cl-bench/files:/home/peter/depot/j/src/org/armedbear/lisp")
74                             ((sub-p namestring "/home/peter/gcl/ansi-tests/")
75                              "/home/peter/gcl/ansi-tests:/home/peter/depot/j/src/org/armedbear/lisp")
76                             ((sub-p namestring "/home/peter/phemlock")
77                              "/home/peter/phemlock/src/core:/home/peter/phemlock/src/user")
78                             (t ; default case: no change
79                              nil))))
80                 ;; If we end up here with a non-NIL TAGPATH, use it to set the
81                 ;; buffer-specific value of the TAG-PATH preference for the current
82                 ;; buffer.
83                 (when tagpath
84                   (setf (variable-value 'tag-path :buffer) tagpath)))))))))
85
86;; Install our hook function.
87(add-hook 'buffer-activated-hook 'my-buffer-activated-hook)
88
89;; Call ADJUST-APPEARANCE after saving ~/.j/prefs.
90(defun my-after-save-hook (buf)
91  (let ((pathname (buffer-pathname buf)))
92    (when (equal pathname #p"/home/peter/.j/prefs")
93      (adjust-appearance))))
94
95(add-hook 'after-save-hook 'my-after-save-hook)
96
97(defun reset-incoming-filters ()
98  (jstatic "resetIncomingFilters" "org.armedbear.j.mail.IncomingFilter"))
99
100(defun add-incoming-filter (mailbox pattern action parameter)
101  (jstatic "addIncomingFilter" "org.armedbear.j.mail.IncomingFilter"
102           mailbox pattern action parameter))
103
104(add-hook 'mailbox-mode-hook
105          (lambda ()
106            (reset-incoming-filters)
107            (add-incoming-filter "inbox"
108                                 "~C linux-kernel"
109                                 "move"
110                                 "{annie}mail/linux-kernel")
111            (add-incoming-filter "inbox"
112                                 "~C ix.netcom.com"
113                                 "move"
114                                 "{annie}mail/netcom")))
115
116(defun maybe-load (pathname)
117  (when (probe-file pathname)
118    (load pathname)))
119
120(maybe-load "/home/peter/.j/key-pressed.lisp")
121(maybe-load "/home/peter/.j/update-check-enabled.lisp")
122
123(maybe-load "/home/peter/depot/j/build-abcl.lisp")
124
125(map-key-for-mode ")" "electricCloseParen" "Lisp Shell")
Note: See TracBrowser for help on using the repository browser.