diff options
| -rw-r--r-- | src/guile/skribilo/source.scm | 102 |
1 files changed, 72 insertions, 30 deletions
diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm index 3513e98..94e6436 100644 --- a/src/guile/skribilo/source.scm +++ b/src/guile/skribilo/source.scm @@ -1,38 +1,43 @@ -;;;; source.scm -- Highlighting source files. -;;;; -;;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> -;;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> -;;;; -;;;; -;;;; This program is free software; you can redistribute it and/or modify -;;;; it under the terms of the GNU General Public License as published by -;;;; the Free Software Foundation; either version 2 of the License, or -;;;; (at your option) any later version. -;;;; -;;;; This program is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;;; GNU General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU General Public License -;;;; along with this program; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -;;;; USA. -;;;; +;;; source.scm -- Highlighting source files. +;;; +;;; Copyright 2005, 2008 Ludovic Courtès <ludo@gnu.org> +;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;; +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, +;;; USA. (define-module (skribilo source) :export (<language> language? language-extractor language-fontifier language-name - source-read-lines source-read-definition source-fontify) + source-read-lines source-read-definition source-fontify + + &source-error source-error? + &no-extractor-error no-extractor-error? + no-extractor-error:language + &definition-not-found-error definition-not-found-error? + definition-not-found-error:definition + definition-not-found-error:language) :use-module (srfi srfi-35) :autoload (srfi srfi-34) (raise) :autoload (srfi srfi-13) (string-prefix-length string-concatenate) - :autoload (skribilo condition) (&file-search-error &file-open-error) + :use-module (skribilo condition) :use-module (skribilo utils syntax) :use-module (skribilo parameters) - :use-module (skribilo lib) :use-module (oop goops) :use-module (ice-9 rdelim)) @@ -41,6 +46,44 @@ ;;; +;;; Error conditions. +;;; + +(define-condition-type &source-error &skribilo-error + source-error?) + +(define-condition-type &no-extractor-error &source-error + no-extractor-error? + (language no-extractor-error:language)) + +(define-condition-type &definition-not-found-error &source-error + definition-not-found-error? + (definition definition-not-found-error:definition) + (language definition-not-found-error:language)) + + +(define (handle-source-error c) + ;; Issue a user-friendly error message for error condition C. + (cond ((no-extractor-error? c) + (format (current-error-port) + (_ "source language `~a' does not have an extractor~%") + (language-name (no-extractor-error:language c)))) + + ((definition-not-found-error? c) + (format (current-error-port) + (_ "source definition of `~a' in language `~a' not found~%") + (definition-not-found-error:definition c) + (language-name (definition-not-found-error:language c)))) + + (else + (format (current-error-port) + (_ "undefined source error: ~A~%") + c)))) + +(register-error-condition-handler! source-error? handle-source-error) + + +;;; ;;; Class definition. ;;; @@ -141,9 +184,8 @@ (let ((p (search-path (*source-path*) file))) (cond ((not (language-extractor lang)) - (skribe-error 'source - "The specified language has not defined extractor" - (slot-ref lang 'name))) + (raise (condition (&no-extractor-error + (language lang))))) ((or (not p) (not (file-exists? p))) (raise (condition (&file-search-error (file-name file) @@ -158,9 +200,9 @@ (unwind-protect (let ((s ((language-extractor lang) ip definition tab))) (if (not (string? s)) - (skribe-error 'source - "Can't find definition" - definition) + (raise (condition (&definition-not-found-error + (definition definition) + (language lang)))) s)) (close-input-port ip)))))))) |