gEDA-cvs: CVS update: gschem.scm

[cvspsrv@xxxxxxxx]

  User: pcjc2   
  Date: 07/02/24 12:14:34

  Modified:    .        Tag: noscreen gschem.scm
  Log:
  Sync with trunk
  
  
  
  
  Revision  Changes    Path
  No                   revision
  
  
  No                   revision
  
  
  1.7.6.1   +18 -26    eda/geda/gaf/gschem/scheme/gschem.scm
  
  (In the diff below, changes in quantity of whitespace are not shown.)
  
  Index: gschem.scm
  ===================================================================
  RCS file: /home/cvspsrv/cvsroot/eda/geda/gaf/gschem/scheme/gschem.scm,v
  retrieving revision 1.7
  retrieving revision 1.7.6.1
  diff -u -b -r1.7 -r1.7.6.1
  --- gschem.scm	9 Sep 2006 02:56:42 -0000	1.7
  +++ gschem.scm	24 Feb 2007 17:14:33 -0000	1.7.6.1
  @@ -125,31 +125,23 @@
       ))
   
   ;; Printing out current key bindings for gEDA (gschem)
  -; Stefan Petersen 1999-04-04 (spe@xxxxxxxxxxxxxx)
  -; Free for all use. Just don't blame me when your house burns up.
  -; Modifed by Ales to fill internal C buffers which are used by the hotkeys
  -; dialog box
   
  -; Ales' function which fills internal C buffers with the keymap info
  -(define (fill-mapped-keys mapped-keys)
  -  (gschem-key-name (symbol->string (car mapped-keys)))
  -  (for-each (lambda (key)
  -	      (cond ((not (null? key))
  -		     (gschem-key-value key))))
  -	    (cdr mapped-keys)))
  +(define (dump-current-keymap)
  +  (dump-keymap global-keymap))
   
  -
  -(define (mapping-keys keymap keys)
  -  (for-each (lambda (mapped-key) ; Receives a pair
  -	      (let ((action (eval-cm (cdr mapped-key))))
  +(use-modules (srfi srfi-13))
  +(define (dump-keymap keymap)
  +  (let loop ((keymap keymap)
  +             (keys   '()))
  +    (if (null? keymap)
  +        '()
  +        (let* ((entry  (car keymap))
  +               (key    (car entry))
  +               (action (eval-cm (cdr entry))))
   		(cond ((list? action)
  -		       (mapping-keys action (append keys (car mapped-key))))
  +                 (append (loop action (cons key keys))
  +                         (loop (cdr keymap) keys)))
   		      (else
  -		       (fill-mapped-keys (list  ; was print
  -					   (cdr mapped-key)
  -					   keys 
  -					   (car mapped-key)))))))
  -	    keymap))
  -
  -(mapping-keys global-keymap '())
  -(gschem-key-done)
  +                 (cons (cons (cdr entry) 
  +                             (string-join (reverse (cons key keys)) " "))
  +                       (loop (cdr keymap) keys))))))))
  
  
  


_______________________________________________
geda-cvs mailing list
geda-cvs@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-cvs