1;; Lepton EDA Schematic Capture 2;; Scheme API 3;; Copyright (C) 2017-2020 Lepton EDA Contributors 4;; 5;; This program is free software; you can redistribute it and/or modify 6;; it under the terms of the GNU General Public License as published by 7;; the Free Software Foundation; either version 2 of the License, or 8;; (at your option) any later version. 9;; 10;; This program is distributed in the hope that it will be useful, 11;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13;; GNU General Public License for more details. 14;; 15;; You should have received a copy of the GNU General Public License 16;; along with this program; if not, write to the Free Software 17;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 18;; 19 20(define-module (schematic symbol check) 21 #:use-module (srfi srfi-1) 22 #:use-module (lepton core toplevel) 23 #:use-module (lepton page) 24 #:use-module (schematic core gettext) 25 #:use-module (schematic dialog) 26 #:use-module (schematic window) 27 #:use-module (symbol blame) 28 #:use-module ((symbol check) #:prefix sym:)) 29 30(define-public (check-symbol) 31 "Checks the active page which should be a symbol, and returns 32its blamed objects." 33 (define (warning-or-error blame) 34 (or (eq? 'error (car blame)) (eq? 'warning (car blame)))) 35 36 (define (blamed-object? object) 37 (not (null? (filter warning-or-error (object-blames object))))) 38 39 (let ((page (active-page))) 40 (sym:check-symbol page) 41 (let ((page-info (object-blaming-info page))) 42 (schematic-message-dialog (if (string-null? page-info) 43 (G_ "Symbol has no pin info.") 44 page-info))) 45 (filter blamed-object? (page-contents page)))) 46 47(define-public (object-blaming-info object) 48 (string-join (map cdr (object-blames object)) "\n" 'suffix)) 49