[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
gEDA-cvs: gaf.git: branch: master updated (1.7.1-20110619-2-gc4ca820)
The branch, master has been updated
via c4ca82095d88e29ade47c8c9f69734cfeaea5c1a (commit)
via f479409ac22750160df85e012012b81785afc37b (commit)
from 12260baebf9f828e9297fc794e911224b8dcd163 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
=========
Summary
=========
gschem/lib/system-gschemrc.scm | 17 ++++-
gschem/scheme/auto-uref.scm | 154 ++++++++++++++++++++-------------------
2 files changed, 92 insertions(+), 79 deletions(-)
=================
Commit Messages
=================
commit c4ca82095d88e29ade47c8c9f69734cfeaea5c1a
Author: Krzysztof KoÅ?ciuszkiewicz <k.kosciuszkiewicz@xxxxxxxxx>
Commit: Krzysztof KoÅ?ciuszkiewicz <k.kosciuszkiewicz@xxxxxxxxx>
auto-uref: smarter calculation of first refes on page
Introduces the "page-offset" concept, where it is assumed
refdeses on each page should start at multiple of page-offset.
So for page-offset = 100 and minimum refdes used on page = 224
the hook will assign next refdes equal to 201.
To enable this feature use (auto-uref-set-page-offset <number>).
Default value of page-offset is 0 which disables the feature.
Currently minimum refdes is calculated separately for each prefix.
:100644 100644 bb0f0e4... 9161909... M gschem/lib/system-gschemrc.scm
:100644 100644 bb91daa... fa77f3b... M gschem/scheme/auto-uref.scm
commit f479409ac22750160df85e012012b81785afc37b
Author: Krzysztof KoÅ?ciuszkiewicz <k.kosciuszkiewicz@xxxxxxxxx>
Commit: Krzysztof KoÅ?ciuszkiewicz <k.kosciuszkiewicz@xxxxxxxxx>
auto-uref: rewrite to support reusing refdeses
auto-uref now scans all objects in the current page in order to find the
first unused refdes which can be assigned to the object.
Duplicate refdeses are handled correctly.
:100644 100644 af7b1ec... bb0f0e4... M gschem/lib/system-gschemrc.scm
:100644 100644 165b1db... bb91daa... M gschem/scheme/auto-uref.scm
=========
Changes
=========
commit c4ca82095d88e29ade47c8c9f69734cfeaea5c1a
Author: Krzysztof KoÅ?ciuszkiewicz <k.kosciuszkiewicz@xxxxxxxxx>
Commit: Krzysztof KoÅ?ciuszkiewicz <k.kosciuszkiewicz@xxxxxxxxx>
auto-uref: smarter calculation of first refes on page
Introduces the "page-offset" concept, where it is assumed
refdeses on each page should start at multiple of page-offset.
So for page-offset = 100 and minimum refdes used on page = 224
the hook will assign next refdes equal to 201.
To enable this feature use (auto-uref-set-page-offset <number>).
Default value of page-offset is 0 which disables the feature.
Currently minimum refdes is calculated separately for each prefix.
diff --git a/gschem/lib/system-gschemrc.scm b/gschem/lib/system-gschemrc.scm
index bb0f0e4..9161909 100644
--- a/gschem/lib/system-gschemrc.scm
+++ b/gschem/lib/system-gschemrc.scm
@@ -837,13 +837,23 @@
; Start of hooks
;
-;
-; Comment in this scheme code if you want automatic numbering when
-; placing new component and copying components
+;;
+;; Comment in this scheme code if you want automatic numbering when
+;; placing new component and copying components.
;
;(load-from-path "auto-uref.scm")
;(add-hook! add-component-hook auto-uref)
;(add-hook! copy-component-hook auto-uref)
+;
+;; Define value of page-offset for auto number on insert.
+;; Refdeses will be numbered from integer multiples of page-offset,
+;; depending on the lowest refdes value found on the page.
+;; If lowest value is 323 and page offset is 100, then next refdes
+;; will be 301.
+;; Setting to 0 disables the feature.
+;
+;(auto-uref-set-page-offset 100)
+
; Define default pin attributes
; Attributes:
diff --git a/gschem/scheme/auto-uref.scm b/gschem/scheme/auto-uref.scm
index bb91daa..fa77f3b 100644
--- a/gschem/scheme/auto-uref.scm
+++ b/gschem/scheme/auto-uref.scm
@@ -19,6 +19,17 @@
(use-modules (ice-9 regex) (srfi srfi-1))
+(define auto-uref-page-offset 0)
+
+;; Redefine value of page-offset.
+;; Refdeses will be numbered from integer multiples of page-offset,
+;; depending on the lowest refdes value found on the page.
+;; If lowest value is 323 and page offset is 100, then next refdes
+;; will be 301.
+;; Setting to 0 disables the feature.
+(define (auto-uref-set-page-offset new-offset)
+ (set! auto-uref-page-offset new-offset))
+
;; Modify attributes of an object to assign next unused refdes value
(define (auto-uref attribs)
@@ -85,7 +96,16 @@
#f)))
(if prefix
(let* ((used-nums (sort-list (collect-all-numbers prefix) <))
- (next-num (find-first-unused used-nums 1)))
+ ; minimum value considering the page-offset
+ (min-num (if (or
+ (null? used-nums)
+ (<= auto-uref-page-offset 0))
+ 0
+ (* (floor (/ (car used-nums)
+ auto-uref-page-offset))
+ auto-uref-page-offset)))
+ ; next refdes number to be assigned
+ (next-num (find-first-unused used-nums (1+ min-num))))
;(simple-format #t "~A: ~A -> ~A~%"
; prefix
; used-nums
commit f479409ac22750160df85e012012b81785afc37b
Author: Krzysztof KoÅ?ciuszkiewicz <k.kosciuszkiewicz@xxxxxxxxx>
Commit: Krzysztof KoÅ?ciuszkiewicz <k.kosciuszkiewicz@xxxxxxxxx>
auto-uref: rewrite to support reusing refdeses
auto-uref now scans all objects in the current page in order to find the
first unused refdes which can be assigned to the object.
Duplicate refdeses are handled correctly.
diff --git a/gschem/lib/system-gschemrc.scm b/gschem/lib/system-gschemrc.scm
index af7b1ec..bb0f0e4 100644
--- a/gschem/lib/system-gschemrc.scm
+++ b/gschem/lib/system-gschemrc.scm
@@ -842,7 +842,6 @@
; placing new component and copying components
;
;(load-from-path "auto-uref.scm")
-;(add-hook! new-page-hook auto-uref-init-page)
;(add-hook! add-component-hook auto-uref)
;(add-hook! copy-component-hook auto-uref)
diff --git a/gschem/scheme/auto-uref.scm b/gschem/scheme/auto-uref.scm
index 165b1db..bb91daa 100644
--- a/gschem/scheme/auto-uref.scm
+++ b/gschem/scheme/auto-uref.scm
@@ -19,94 +19,78 @@
(use-modules (ice-9 regex) (srfi srfi-1))
-;; Two level associative list - page at first level, refdes prefix at second
-(define page-prefix-list '())
-
;; Modify attributes of an object to assign next unused refdes value
(define (auto-uref attribs)
- ; Map of refdes prefix and next available number for current page
- (define refdes-map
- (let ((old (assoc-ref page-prefix-list (get-current-page))))
- (if old old '())))
+ ; Return (prefix . number) on match or #f on failure
+ (define (split-value value)
+ (let ((match (string-match "^([A-Za-z]+)([0-9]+)$" value)))
+ (if match
+ (cons (match:substring match 1)
+ (string->number (match:substring match 2)))
+ #f)))
- ; Retrieve next available number for given refdes prefix
- ; Update refdes-map to track used refdeses
- (define (get-next-uref prefix)
- (let* ((old (assoc-ref refdes-map prefix))
- (new (if old (1+ old) 1)))
- (set! refdes-map (assoc-set! refdes-map prefix new))
- new))
-
; Extract prefix from a refdes attribute value
(define (get-prefix value)
- (let ((prefix (string-match "^[A-Z]*" value)))
+ (let ((prefix (string-match "^[A-Za-z]+" value)))
(if (= 0 (match:end prefix))
#f
(match:substring prefix))))
- ; Process object attributes
- (for-each
- (lambda (attrib)
- (let* ((name-value (get-attribute-name-value attrib))
- (name (car name-value))
- (value (cdr name-value))
- (prefix (get-prefix value)))
- ; If get-prefix fails (returns #f) there is no ? in the string
- (if (and prefix
- (string=? name "refdes")
- (not (attrib-inherited? attrib)))
- (set-attribute-value! attrib
- (string-append
- prefix
- (number->string
- (get-next-uref prefix)))))))
- attribs)
-
- ; Update global map with modified map for current page
- (set! page-prefix-list (assoc-set! page-prefix-list
- (get-current-page)
- refdes-map)))
-
-
-;; Scan for existing refdeses in the page and initialise page-prefix-list
-(define (auto-uref-init-page page)
-
- ; Return (prefix . number) on match or #f on failure
- (define (split-attr value)
- (let ((match (string-match "^([A-Z]+)([0-9]+)$" value)))
- (if match
- (cons (match:substring match 1)
- (string->number (match:substring match 2)))
- #f)))
+ ; Filter non-inherited refdes values
+ (define (refdes-attrs attribs)
+ (filter (lambda (a)
+ (and
+ (not (attrib-inherited? a))
+ (string=? "refdes" (car (get-attribute-name-value a)))))
+ attribs))
- ; Update refdes map with given prefix-num pair
- (define (update-refdes-map prefix-num)
- (let* ((prefix (car prefix-num))
- (value (cdr prefix-num))
- (old-value (assoc-ref refdes-map prefix))
- (new-value (if old-value (max old-value value) value)))
- (set! refdes-map (assoc-set! refdes-map prefix new-value))))
+ ; Extract numbers from refdeses that have given prefix
+ (define (extract-numbers object prefix)
+ (let* ((refdeses (refdes-attrs (get-object-attributes object)))
+ (vals (map (lambda (a)
+ (cdr (get-attribute-name-value a)))
+ refdeses))
+ (prefix-numbers (filter-map split-value vals))
+ (numbers (filter-map (lambda (n.v)
+ (if (string=? prefix (car n.v))
+ (cdr n.v)
+ #f))
+ prefix-numbers)))
+ numbers))
- ; Execute update for a single object
- (define (handle-object object)
- (let* ((all-attribs (get-object-attributes object))
- (own-attribs (filter (lambda (a)
- (not (attrib-inherited? a))) all-attribs))
- (name-vals (map get-attribute-name-value own-attribs))
- (refdeses (filter (lambda (a)
- (string=? "refdes" (car a)))
- name-vals))
- (prefix-pairs (filter-map (lambda (a)
- (split-attr (cdr a)))
- refdeses)))
- (for-each update-refdes-map prefix-pairs)))
+ ; Collect all numbers associated with prefix on current page
+ (define (collect-all-numbers prefix)
+ (let ((objects (get-objects-in-page (get-current-page))))
+ (concatenate (map (lambda (o)
+ (extract-numbers o prefix))
+ objects))))
- ; Clear refdes map for given page
- (define (refdes-map) '())
+ ; Return first number not present in used greater or equal to minimum
+ (define (find-first-unused used minimum)
+ (define (go n xs)
+ (cond ((null? xs) n)
+ ((< n (car xs)) n)
+ ((= n (car xs)) (go (1+ n) (cdr xs)))
+ (else (go n (cdr xs)))))
+ (go minimum used))
- ; Update refdes maps for objects in given page
- (for-each handle-object (get-objects-in-page page))
+ ; Do the work - first check if attributes contain refdes with prefix
+ (let* ((refdeses (refdes-attrs attribs))
+ (refdes (if (null? refdeses)
+ #f
+ (car refdeses)))
+ (prefix (if refdes
+ (get-prefix (cdr (get-attribute-name-value refdes)))
+ #f)))
+ (if prefix
+ (let* ((used-nums (sort-list (collect-all-numbers prefix) <))
+ (next-num (find-first-unused used-nums 1)))
+ ;(simple-format #t "~A: ~A -> ~A~%"
+ ; prefix
+ ; used-nums
+ ; next-num)
+ (set-attribute-value!
+ refdes
+ (string-append prefix (number->string next-num)))))))
- ; Overwrite map for given page
- (set! page-prefix-list (assoc-set! page-prefix-list page refdes-map)))
_______________________________________________
geda-cvs mailing list
geda-cvs@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-cvs