Forum Wiki Galerie Kontakt Wie man Fragen richtig stellt. Tutorial Forum
Zurück   GIMP-Forum 3.0 > Arbeiten mit Gimp > GIMP-Ressourcen > Skripte

Hinweise
Alt 09.01.2009, 18:36   #1
kumbbl
Neuer Benutzer
 
Registriert seit: 07.01.2009
Beiträge: 26
Standard Nützliche String- und Filename-Utility-Proceduren - Code anbei

Hallo zusammen,

nachdem ich feststellen musste, dass die Serienausstattung von Proceduren zur String- und Filename-Behandung in Script-Fu/Scheme äußerst mager ist (IMHO zu mager), habe ich mal ein bischen recherchiert und folgende String-Filename-Utility-scm-Bibliothek gebaut.

Kommentare sind enthalten - möglicherweise gibts noch andere leute, die nach solche Proceduren suchen (einfach Code in ein File *.scm in das persönliche Scripte-verzeichnis von Gimp speichern und voila)

Getestet mit Gimp 2.6.3...

Anregungen für Verbesserungen sind natürlich willkommen!

Code:
; kumbbl-string-filename-utilities.scm
; by Klaus Berndl

; Description
;
; This implements a some utilitis for string- and filename-handling
; exports - see funtions below and the comments in front of them

; License:
;
; 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.
;
; The GNU Public License is available at
; http://www.gnu.org/copyleft/gpl.html

; ---------- string-utilities -----------------

; Return the index of the first occurence of a-char in str, or #f
(define (string-index str a-char)
  (let loop ((pos 0))
    (cond
      ((>= pos (string-length str)) #f) ; whole string has been searched, in vain
      ((char=? a-char (string-ref str pos)) pos)
      (else (loop (+ 1 pos))))))

; Return the index of the last occurence of a-char in str, or #f
(define (string-index-right str a-char)
  (let loop ((pos (- (string-length str) 1)))
    (cond
      ((negative? pos) #f)     ; whole string has been searched, in vain
      ((char=? a-char (string-ref str pos)) pos)
      (else (loop (- pos 1))))))
(define string-rindex string-index-right)


; string-contains    s1 s2 [start1 end1 start2 end2] -> integer or false
; string-contains-ci s1 s2 [start1 end1 start2 end2] -> integer or false
;     Does string s1 contain string s2?
;     Return the index in s1 where s2 occurs as a substring, or false. The
;     optional start/end indices restrict the operation to the indicated
;     substrings.
; We do not support the optional arguments
(define (string-contains str pattern)
  (let* ((pat-len (string-length pattern))
         (search-span (- (string-length str) pat-len))
         (c1 (if (zero? pat-len) #f (string-ref pattern 0)))
         (c2 (if (<= pat-len 1) #f (string-ref pattern 1))))
    (cond
     ((not c1) 0)           ; empty pattern, matches upfront
     ((not c2) (string-index str c1)) ; one-char pattern
     (else                  ; matching a pattern of at least two chars
    (let outer ((pos 0))
          (cond
        ((> pos search-span) #f)    ; nothing was found thru the whole str
            ((not (char=? c1 (string-ref str pos)))
                (outer (+ 1 pos)))    ; keep looking for the right beginning
            ((not (char=? c2 (string-ref str (+ 1 pos))))
                (outer (+ 1 pos)))    ; could've done pos+2 if c1 == c2....
            (else                      ; two char matched: high probability
                       ; the rest will match too
        (let inner ((i-pat 2) (i-str (+ 2 pos)))
                   (if (>= i-pat pat-len) pos ; whole pattern matched
                      (if (char=? (string-ref pattern i-pat)
                                  (string-ref str i-str))
                        (inner (+ 1 i-pat) (+ 1 i-str))
                        (outer (+ 1 pos))))))))))))    ; mismatch after partial match

(define (substring? pattern str) (string-contains str pattern))


; Here are some specialized substring? functions
; checks to make sure that PATTERN is a prefix of STRING
;
;          (string-prefix? "pir" "pirate")             =>  #t
;          (string-prefix? "rat" "outrage")            =>  #f
;          (string-prefix? "" any-string)              =>  #t
;          (string-prefix? any-string any-string)      =>  #t
(define (string-prefix? pattern str)
  (let loop ((i 0))
    (cond
      ((>= i (string-length pattern)) #t)
      ((>= i (string-length str)) #f)
      ((char=? (string-ref pattern i) (string-ref str i))
        (loop (inc i)))
      (else #f))))

(define (string-prefix-ci? pattern str)
  (let loop ((i 0))
    (cond
      ((>= i (string-length pattern)) #t)
      ((>= i (string-length str)) #f)
      ((char-ci=? (string-ref pattern i) (string-ref str i))
        (loop (inc i)))
      (else #f))))

; checks to make sure that PATTERN is a suffix of STRING
;
;          (string-suffix? "ate" "pirate")             =>  #t
;          (string-suffix? "rag" "outrage")            =>  #f
;          (string-suffix? "" any-string)              =>  #t
;          (string-suffix? any-string any-string)      =>  #t
(define (string-suffix? pattern str)
  (let loop ((i (dec (string-length pattern))) (j (dec (string-length str))))
    (cond
      ((negative? i) #t)
      ((negative? j) #f)
      ((char=? (string-ref pattern i) (string-ref str j))
        (loop (dec i) (dec j)))
      (else #f))))

(define (string-suffix-ci? pattern str)
  (let loop ((i (dec (string-length pattern))) (j (dec (string-length str))))
    (cond
      ((negative? i) #t)
      ((negative? j) #f)
      ((char-ci=? (string-ref pattern i) (string-ref str j))
        (loop (dec i) (dec j)))
      (else #f)))) 

; ---------- filename-utilities -------------------

; return all parts of the full filename of an image as a list:
; (<directory> <directory-separator> <basename> <extension>)
; All parts of the result-list are strings
;
; examples:
; suppose <image> hat the full filename "C:\any\dir\at\my\drive\images\MyFirstImage.jpg".
; Then (kumbbl-image-get-parts-of-filename <image>) returns
;      '("C:\\any\\dir\\at\\my\\drive\\images" "\\" "MyFirstImage" "jpg")
; TODO:
; make failure-save when called for an image without an extension-part
; in its filename - should be seldom but ........ ;-)

(define (kumbbl-image-get-parts-of-filename InImage)
   (let* ((image-name (car (gimp-image-get-name InImage)))
          (image-full-filename (car (gimp-image-get-filename InImage)))
          (extension (substring image-name
                                (+ 1 (string-rindex image-name #\.))))
          (basename (substring image-name 0 (string-rindex image-name #\.)))
      (beginning-image-name (substring? image-name image-full-filename))
      (dir-separator (substring image-full-filename 
                    (- beginning-image-name 1)
                    beginning-image-name))
          (directory (substring image-full-filename
                          0 (- beginning-image-name 1))))
     (list directory dir-separator basename extension)))

; self explanating

(define (kumbbl-image-get-directory InImage)
   (car (kumbbl-image-get-parts-of-filename InImage)))

(define (kumbbl-image-get-dir-separator InImage)
   (car (cdr (kumbbl-image-get-parts-of-filename InImage))))

(define (kumbbl-image-get-basename InImage)
   (car (cdr (cdr (kumbbl-image-get-parts-of-filename InImage)))))

(define (kumbbl-image-get-extension InImage)
   (car (cdr (cdr (cdr (kumbbl-image-get-parts-of-filename InImage))))))
kumbbl ist offline   Mit Zitat antworten
 

Lesezeichen

Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge hochzuladen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

BB-Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist Aus.

Gehe zu


Alle Zeitangaben in WEZ +2. Es ist jetzt 10:17 Uhr.


Powered by vBulletin® Version 3.8.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.