← Back to branch summary

~registry/texmacs/trunk

« back to all changes in this revision

Viewing changes to src/TeXmacs/progs/kernel/texmacs/tm-preferences.scm

  • Committer: mgubi
  • Date: 2009-06-04 15:13:41 UTC
  • Revision ID: svn-v4:64cb5145-927a-446d-8aed-2fb7b4773692:trunk:2717
Support for X11 TeXmacs.app on Mac

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/TeXmacs/progs/kernel/texmacs/tm-preferences.scm
1
 
 
2
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3
 
;;
4
 
;; MODULE      : tm-preferences.scm
5
 
;; DESCRIPTION : management of the user preferences
6
 
;; COPYRIGHT   : (C) 1999  Joris van der Hoeven
7
 
;;
8
 
;; This software falls under the GNU general public license version 3 or later.
9
 
;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
10
 
;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
11
 
;;
12
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13
 
 
14
 
(texmacs-module (kernel texmacs tm-preferences)
15
 
  (:use (kernel texmacs tm-define)))
16
 
 
17
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
18
 
;; Defining preference call back routines
19
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
20
 
 
21
 
(define-public preferences-table (make-ahash-table))
22
 
(define-public preferences-default (make-ahash-table))
23
 
(define-public preferences-call-back (make-ahash-table))
24
 
 
25
 
(define (define-preference x)
26
 
  (with (which value call-back) x
27
 
    `(if (not (ahash-ref preferences-default ,which))
28
 
         (ahash-set! preferences-default ,which ,value))))
29
 
 
30
 
(define (define-preference-call-back x)
31
 
  (with (which value call-back) x
32
 
    `(begin
33
 
       (ahash-set! preferences-call-back ,which ,call-back)
34
 
       (notify-preference ,which))))
35
 
 
36
 
(define-public-macro (define-preferences . l)
37
 
  (append '(begin)
38
 
          (map-in-order define-preference l)
39
 
          (map-in-order define-preference-call-back l)))
40
 
 
41
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42
 
;; Setting and getting preferences
43
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44
 
 
45
 
(define (test-preference? which what)
46
 
  (== what (get-preference which)))
47
 
 
48
 
(tm-define (set-preference which what)
49
 
  (:synopsis "Set preference @which to @what")
50
 
  (:check-mark "*" test-preference?)
51
 
  (ahash-set! preferences-table which what)
52
 
  ;;(display* "set-preference " which " := " what "\n")
53
 
  ((get-call-back which) which (get-preference which))
54
 
  (save-preferences))
55
 
 
56
 
(tm-define (reset-preference which)
57
 
  (:synopsis "Revert preference @which to default setting")
58
 
  (ahash-remove! preferences-table which)
59
 
  ((get-call-back which) which (get-preference which))
60
 
  (save-preferences))
61
 
 
62
 
(tm-define (get-preference which)
63
 
  (:synopsis "Get preference @which")
64
 
  (if (ahash-ref preferences-table which)
65
 
      (ahash-ref preferences-table which)
66
 
      (ahash-ref preferences-default which)))
67
 
 
68
 
(define (preference-on? which)
69
 
  (test-preference? which "on"))
70
 
 
71
 
(tm-define (toggle-preference which)
72
 
  (:synopsis "Toggle the preference @which")
73
 
  (:check-mark "v" preference-on?)
74
 
  (let ((what (get-preference which)))
75
 
    (set-preference which (cond ((== what "on") "off")
76
 
                                ((== what "off") "on")
77
 
                                (else what)))))
78
 
 
79
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
80
 
;; Applying preferences
81
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
82
 
 
83
 
(define (get-call-back what)
84
 
  (let ((r (ahash-ref preferences-call-back what)))
85
 
    (if r r (lambda args (noop)))))
86
 
 
87
 
(define-public (notify-preference var)
88
 
  "Notify a change in preference @var"
89
 
  ;;(display* "notify-preference " var ", " (get-preference var) "\n")
90
 
  ((get-call-back var) var (get-preference var)))
91
 
 
92
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
93
 
;; Initialize preferences and consulting preferences
94
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
95
 
 
96
 
(define user-preferences '())
97
 
(define saved-preferences '())
98
 
 
99
 
(define (preferences->list table)
100
 
  (let* ((folder (lambda (key im tail) (cons (list key im) tail)))
101
 
         (unsorted (ahash-fold folder '() table))
102
 
         (comp? (lambda (l1 l2) (string<=? (car l1) (car l2)))))
103
 
    (list-sort unsorted comp?)))
104
 
 
105
 
(define (save-preferences)
106
 
  (set! user-preferences (preferences->list preferences-table))
107
 
  (if (!= user-preferences saved-preferences)
108
 
      (begin
109
 
        (save-object "$TEXMACS_HOME_PATH/system/preferences.scm"
110
 
                     user-preferences)
111
 
        (set! saved-preferences user-preferences))))
112
 
 
113
 
(define (retrieve-preferences)
114
 
  "Retrieve preferences from disk"
115
 
  (if (url-exists? "$TEXMACS_HOME_PATH/system/preferences.scm")
116
 
      (set! saved-preferences
117
 
            (load-object "$TEXMACS_HOME_PATH/system/preferences.scm")))
118
 
  (fill-dictionary preferences-table saved-preferences))
119
 
 
120
 
(retrieve-preferences)