trans-coord/gnun/server/gnun recode-escape.in [sr-hr]

[Kaloian Doganov]

CVSROOT:        /sources/trans-coord
Module name:    trans-coord
Branch:         sr-hr
Changes by:     Kaloian Doganov <kaloian>       09/08/02 13:30:49

Added files:
        gnun/server/gnun: recode-escape.in 

Log message:
        New file.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/trans-coord/gnun/server/gnun/recode-escape.in?cvsroot=trans-coord&only_with_tag=sr-hr&rev=1.1.2.1

Patches:
Index: recode-escape.in
===================================================================
RCS file: recode-escape.in
diff -N recode-escape.in
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ recode-escape.in    2 Aug 2009 13:30:48 -0000       1.1.2.1
@@ -0,0 +1,247 @@
address@hidden@ \                                       -*-scheme-*-
+-e main --debug -s
+!#
+;; @configure_input@
+
+;; Copyright (C) 2009 Free Software Foundation, Inc.
+
+;; This file is part of GNUnited Nations.
+
+;; GNUnited Nations 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 3 of the
+;; License, or (at your option) any later version.
+
+;; GNUnited Nations 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 GNUnited Nations.  If not, see
+;; <http://www.gnu.org/licenses/>.
+
+(define version-message
+  (string-append
+   "recode-escape (@PACKAGE_NAME@) @address@hidden"
+   "Copyright (C) 2009 Free Software Foundation, Inc.\n"
+   "You may redistribute copies of GNUnited Nations\n"
+   "under the terms of the GNU General Public License.\n"
+   "For more information about these matters, see the file named COPYING.\n"))
+
+; FIXME: Use AC_INIT's 5th argument and AC_PACKAGE_URL once Autoconf
+; 2.64 is released.
+(define help-message
+  (string-append
+   "Usage: recode-escape [OPTION]\n"
+   "\n"
+   "      --trans-attrib=ATTRIB  Comma separated list of translatable 
attributes\n"
+   "\n"
+   "      --version              Just print version info and return\n"
+   "      --help                 Print this usage information message\n"
+   "\n"
+   "Report bugs to @address@hidden"
+   "@PACKAGE_NAME@ home page: <http://www.gnu.org/software/@PACKAGE@/>\n"
+   "General help using GNU software: <http://www.gnu.org/gethelp/>\n"))
+
+(define option-grammar
+  '((trans-attrib (single-char #\t) (value #t))
+    (version (value #f))
+    (help (value #f))))
+
+(define default-trans-attrib
+  "alt,title") ; FIXME: Update with po4a's behaviour
+
+(define url-regexps
+  
'("((((news|telnet|nntp|file|https?|ftps?)://)|(www|ftp)[-A-Za-z0-9]*\\.)[-A-Za-z0-9\\.]+)(:[0-9]*)?/[-A-Za-z0-9_\\$\\.\\+\\!\\*\\(\\),;:@&=\\?/~\\#\\%]*[^]'\\.}>\\),\\\"]"
+    
"((((news|telnet|nntp|file|https?|ftps?)://)|(www|ftp)[-A-Za-z0-9]*\\.)[-A-Za-z0-9\\.]+)(:[0-9]*)?"
+  "(mailto:)address@hidden"))
+
+(use-modules (ice-9 regex)
+            (ice-9 rdelim)
+            (ice-9 getopt-long)
+            (srfi srfi-13))
+
+(define (main args)
+  (let* ((options (catch 'misc-error
+                        (lambda () (getopt-long args option-grammar))
+                        (lambda (key subr message args data)
+                          (die (apply format #f message args)))))
+        (opt (lambda args (apply option-ref options args))))
+    (cond ((opt 'version #f) (version))
+         ((opt 'help #f) (help))
+         (else
+          (escape-all (current-input-port)
+                      (map
+                       string-trim-both
+                       (string-split (or (opt 'trans-attrib #f)
+                                         default-trans-attrib)
+                                     #\,)))))))
+
+(define (die message)
+  (display "recode-escape: " (current-error-port))
+  (display message (current-error-port))
+  (newline (current-error-port))
+  (exit 2))
+
+(define (version)
+  (display version-message))
+
+(define (help)
+  (display help-message))
+
+; Returns representation of STR in escape syntax.
+(define (recode-escape str)
+  (apply
+   string-append
+   (map
+    (lambda (c)
+      (string-append "\\" (number->string (char->integer c))))
+    (string->list str))))
+
+; Searches for REGEXP matches in TARGET string and applies PROC for
+; every match found.
+(define (string-re-subst regexp target proc)
+  (with-output-to-string
+   (lambda ()
+     (regexp-substitute/global (current-output-port)
+                              regexp
+                              target
+                              'pre
+                              proc
+                              'post))))
+
+; Searches for all possible fragments to escape, then dispatches to a
+; special procedure to handle every special case.  INPUT is an input
+; port and TRANS-ATTRIB is a list of translatable attributes.
+(define (escape-all input trans-attrib)
+  ; There are three kinds expressions to convert - HTML tags,
+  ; alternative expressions and HTML entities.  All of them could
+  ; occur standalone in the input, but:
+  ;
+  ;   * Translatable attributes in HTML tags could contain
+  ;     alternatives and/or primitive expressions;
+  ;   
+  ;   * alternative expressions could contain primitive expressions;
+  ;
+  ;   * primitive expressions (HTML tags, URLs, mail addresses, etc.)
+  ;     could NOT contain subexpressions.
+  ;
+  ; So, to handle input correctly, the order of processing is
+  ; important.  The most general containers must be processed first,
+  ; and the most primitive expressions - last:
+  ;
+  ;   1. HTML tags;
+  ;   2. alternative expressions;
+  ;   3. primitive expressions.
+
+  (display
+   ; Process primitive expressions
+   (escape-html-entities
+    (escape-urls
+     ; Process alternative expressions
+     (escape-alternatives
+      ; Escape HTML tags
+      (escape-html-tags
+       ; First of all process anything that looks like our escape
+       ; syntax
+       (escape-escapes (read-delimited ""))
+       trans-attrib))))))
+
+; Escape everything that looks like escape sequence in STR.
+(define (escape-escapes str)
+  (string-re-subst
+   "\\\\[0-9]+"
+   str
+   (lambda (m)
+     (recode-escape (match:substring m 0)))))
+
+; Escape opening and closing HTML tags in STR.
+(define (escape-html-tags str trans-attrib)
+   ; Escape opening tags
+  (let ((str
+   (string-re-subst
+    "<[A-Za-z0-9_:.-]+(\\s+[A-Za-z0-9_:.-]+(=\".*?\"))?*/?>"
+    str
+    (lambda (m)
+      (escape-html-tag-open (match:substring m 0) trans-attrib)))))
+    ; Escape closing tags
+    (string-re-subst
+     "</([A-Za-z0-9_:.-]+)>"
+     str
+     (lambda (m)
+       (string-append
+       "</"
+       (recode-escape (match:substring m 1))
+       ">")))))
+
+; Escapes opening tags in form <tag attr="..."> in STR.
+(define (escape-html-tag-open str trans-attrib)
+  (string-re-subst
+   "^<([A-Za-z0-9_:.-]+)(\\s+[A-Za-z0-9_:.-]+(=\".*?\")?)*(/)?>$"
+   str
+   (lambda (m)
+     (string-append
+      "<"
+      (recode-escape (match:substring m 1))
+      (if (match:substring m 2)
+         (escape-tag-attribs (match:substring m 2) trans-attrib)
+         "")
+      (or (match:substring m 4) "")
+      ">"))))
+
+; Escape attribute values of non-translatable attributes in STR using
+; TRANS-ATTRIB as list of translatable attributes.
+(define (escape-tag-attribs str trans-attrib)
+  (string-re-subst
+   "([A-Za-z0-9_:.-]+)(=\"([^\"]*)\")?"
+   str
+   (lambda (m)
+     (let ((attrib (match:substring m 1)))
+       (string-append
+       (recode-escape attrib)
+       (if (match:substring m 2)
+           (let ((value (match:substring m 3)))
+             (string-append "=\""
+                            (if (member attrib trans-attrib)
+                                value
+                                (recode-escape value))
+                          "\""))
+           ""))))))
+
+; Escapes alternative expressions in the form [a|b|...] in STR.
+(define (escape-alternatives str)
+  ; Detect alternatives
+  (string-re-subst
+   "\\[([^][|]*?)\\|(([^][|]*?)\\|?)*\\]"
+   str
+   ; Process them
+   (lambda (m)
+     (string-re-subst
+      "[^][|]+"
+      (match:substring m 0)
+      (lambda (m)
+       (string-append
+        (recode-escape (match:substring m 0))))))))
+
+; Escape HTML entities in the form "&amp;" in STR.
+(define (escape-html-entities str)
+  (string-re-subst
+   "&([A-Za-z0-9_:.-]+);"
+   str
+   (lambda (m)
+     (string-append
+      "&"
+      (recode-escape (match:substring m 1))
+      ";"))))
+
+; Escape URLs in STR.
+(define (escape-urls str)
+  (let ((url-regexp (string-append "("
+                                  (string-join url-regexps ")|(")
+                                  ")")))
+    (string-re-subst
+     url-regexp
+     str
+     (lambda (m)
+       (recode-escape (match:substring m 0))))))