IUP

Check-in [c7c1c37d26]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added an accessor for user-defined attribute names
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c7c1c37d268346bf6e110e85efcde949fe5def1c
User & Date: murphy 2015-07-30 17:22:18
Context
2015-08-03
12:41
Improved callback handling and destructor safety check-in: 371a59c42d user: murphy tags: trunk
2015-07-30
17:22
Added an accessor for user-defined attribute names check-in: c7c1c37d26 user: murphy tags: trunk
2015-07-27
00:03
Updated CHICKEN release information file check-in: 3c24b754d1 user: murphy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to api/base.wiki.

43
44
45
46
47
48
49





50
51
52
53
54
55
56
<h2>Attribute Functions</h2>

<h3><a id="attribute"><code><nowiki>(attribute [handle (or/c ihandle? #f)] [name (or/c symbol? string?)]) → (or/c string? #f)</nowiki></code></a></h3>

Gets the value of an attribute. If the handle is <code>#f</code>, a global
attribute is accessed. Attribute values are always returned as strings,
which is the native form in which they are stored.






<h3><a id="attribute-set_"><code>
	<nowiki>(attribute-set! [handle (or/c ihandle? #f)] [name (or/c symbol? string?)] [value any/c]) → void?</nowiki><br>
	<nowiki>(set! (attribute [handle (or/c ihandle? #f)] [name (or/c symbol? string?)]) [value any/c]) → void?</nowiki>
</code></a></h3>

Sets the value of an attribute. If the handle is <code>#f</code>, a global







>
>
>
>
>







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
<h2>Attribute Functions</h2>

<h3><a id="attribute"><code><nowiki>(attribute [handle (or/c ihandle? #f)] [name (or/c symbol? string?)]) → (or/c string? #f)</nowiki></code></a></h3>

Gets the value of an attribute. If the handle is <code>#f</code>, a global
attribute is accessed. Attribute values are always returned as strings,
which is the native form in which they are stored.

<h3><a id="attributes"><code><nowiki>(attributes [handle (or/c ihandle? #f)]) → (listof string?)</nowiki></code></a></h3>

Gets a list of all user-defined attributes set on a given handle. If
the handle is <code>#f</code>, the global attributes are examined.

<h3><a id="attribute-set_"><code>
	<nowiki>(attribute-set! [handle (or/c ihandle? #f)] [name (or/c symbol? string?)] [value any/c]) → void?</nowiki><br>
	<nowiki>(set! (attribute [handle (or/c ihandle? #f)] [name (or/c symbol? string?)]) [value any/c]) → void?</nowiki>
</code></a></h3>

Sets the value of an attribute. If the handle is <code>#f</code>, a global

Changes to chicken/iup-base.scm.

156
157
158
159
160
161
162















163
164
165
166
167
168
169
	(foreign-safe-lambda void "IupResetAttribute" ihandle iname/upcase))

(define attribute
  (getter-with-setter
  	(foreign-safe-lambda c-string "IupGetAttribute" ihandle iname/upcase)
  	attribute-set!))
















(define handle-name-set!
	(letrec ([handle-set! (foreign-lambda ihandle "IupSetHandle" iname/downcase ihandle)])
		(lambda (handle name)
			(handle-set! (or name (handle-name handle)) (and name handle)))))

(define handle-name
  (getter-with-setter







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
	(foreign-safe-lambda void "IupResetAttribute" ihandle iname/upcase))

(define attribute
  (getter-with-setter
  	(foreign-safe-lambda c-string "IupGetAttribute" ihandle iname/upcase)
  	attribute-set!))

(define attributes
	(foreign-primitive scheme-object ([ihandle handle])
		"int n = IupGetAllAttributes(handle, NULL, 0);"
		"if (n > 0) {"
		"  char **buf = (char **) alloca(n * sizeof(char *));"
		"  if (IupGetAllAttributes(handle, buf, n) == n) {"
		"    int i, m = C_SIZEOF_LIST(n);"
		"    for (i = 0; i < n; ++i) m += C_SIZEOF_STRING(strlen(buf[i]));"
		"    C_word *mrk = C_alloc(m), lst = C_SCHEME_END_OF_LIST;"
		"    for (i = n-1; i >= 0; --i) lst = C_pair(&mrk, C_string2(&mrk, buf[i]), lst);"
		"    C_return(lst);"
		"  }"
		"}"
		"C_return(C_SCHEME_END_OF_LIST);"))

(define handle-name-set!
	(letrec ([handle-set! (foreign-lambda ihandle "IupSetHandle" iname/downcase ihandle)])
		(lambda (handle name)
			(handle-set! (or name (handle-name handle)) (and name handle)))))

(define handle-name
  (getter-with-setter

Changes to chicken/iup.scm.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
  lolevel data-structures extras srfi-1 srfi-13 srfi-42 srfi-69 irregex posix)

(module iup-base
	(ihandle->pointer pointer->ihandle ihandle-list->pointer-vector ihandle?
	 istatus->integer integer->istatus
	 iname->string string->iname
	 thread-watchdog iup-version load/led
	 attribute attribute-set! attribute-reset!
	 handle-name handle-name-set! handle-ref
	 main-loop main-loop-step main-loop-level main-loop-exit main-loop-flush
	 callback callback-set!
	 make-constructor-procedure optional-args
	 create destroy! map-peer! unmap-peer!
	 class-name class-type save-attributes!
	 parent parent-dialog sibling







|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
  lolevel data-structures extras srfi-1 srfi-13 srfi-42 srfi-69 irregex posix)

(module iup-base
	(ihandle->pointer pointer->ihandle ihandle-list->pointer-vector ihandle?
	 istatus->integer integer->istatus
	 iname->string string->iname
	 thread-watchdog iup-version load/led
	 attribute attributes attribute-set! attribute-reset!
	 handle-name handle-name-set! handle-ref
	 main-loop main-loop-step main-loop-level main-loop-exit main-loop-flush
	 callback callback-set!
	 make-constructor-procedure optional-args
	 create destroy! map-peer! unmap-peer!
	 class-name class-type save-attributes!
	 parent parent-dialog sibling

Changes to racket/base.rkt.

143
144
145
146
147
148
149














150
151
152
153
154
155
156
...
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
(define attribute
  (getter-with-setter
   (get-ffi-obj
    "IupGetAttribute" libiup
    (_fun [handle : _ihandle/null] [name : _iname/upcase] -> [value : _string/utf-8]))
   attribute-set!))















(define handle-name-set!
  (get-ffi-obj
   "IupSetHandle" libiup
   (_fun (handle name)
         :: [name : _iname/downcase = (or name (handle-name handle))]
         [handle : _ihandle/null = (and name handle)]
         -> [handle : _ihandle/null])))
................................................................................
      (callback-set! watchdog 'action-cb scheme-check-threads)
      (attribute-set! watchdog 'time 500)
      (attribute-set! watchdog 'run #t)
      watchdog)))

(provide
 thread-watchdog iup-version load/led
 attribute attribute-set! attribute-reset!
 handle-name handle-name-set! handle-ref
 main-loop main-loop-step main-loop-level main-loop-exit main-loop-flush
 callback callback-set!
 make-constructor-procedure
 create destroy! map-peer! unmap-peer!
 class-name class-type save-attributes!
 parent parent-dialog sibling







>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
...
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
(define attribute
  (getter-with-setter
   (get-ffi-obj
    "IupGetAttribute" libiup
    (_fun [handle : _ihandle/null] [name : _iname/upcase] -> [value : _string/utf-8]))
   attribute-set!))

(define attributes
  (letrec ([get-attributes
            (get-ffi-obj
             "IupGetAllAttributes" libiup
             (_fun [handle : _ihandle/null] [names : (_list o _string/utf-8 n)] [n : _int]
                   -> [n* : _int]
                   -> (values n* names)))])
    (λ (handle)
      (let-values ([(n names) (get-attributes handle 0)])
        (if (zero? n)
            names
            (let-values ([(n names) (get-attributes handle n)])
              names))))))

(define handle-name-set!
  (get-ffi-obj
   "IupSetHandle" libiup
   (_fun (handle name)
         :: [name : _iname/downcase = (or name (handle-name handle))]
         [handle : _ihandle/null = (and name handle)]
         -> [handle : _ihandle/null])))
................................................................................
      (callback-set! watchdog 'action-cb scheme-check-threads)
      (attribute-set! watchdog 'time 500)
      (attribute-set! watchdog 'run #t)
      watchdog)))

(provide
 thread-watchdog iup-version load/led
 attribute attributes attribute-set! attribute-reset!
 handle-name handle-name-set! handle-ref
 main-loop main-loop-step main-loop-level main-loop-exit main-loop-flush
 callback callback-set!
 make-constructor-procedure
 create destroy! map-peer! unmap-peer!
 class-name class-type save-attributes!
 parent parent-dialog sibling