From: Jan Nieuwenhuizen Date: Sat, 14 May 2005 21:43:04 +0000 (+0000) Subject: * scripts/lilypond-invoke-editor.scm (dissect-uri): Handle URIs X-Git-Tag: release/2.5.25~35 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=0fcd8c283c45644a92d2308f1cd0d82a1e63380b;p=lilypond.git * scripts/lilypond-invoke-editor.scm (dissect-uri): Handle URIs with Windows root in file name. * scm/backend-library.scm (ly:system): Only redirect output (using system and shell, ugh) if /dev/null is writable. * Documentation/pictures/GNUmakefile [PLATFORM_WINDOWS]: Build windows icon. * scm/lily.scm (is-absolute?): New function. Fixes absolute files on Mingw. * scm/output-ps.scm (grob-cause): Use it. Fixes PDF point and click. * flower/file-path.cc (is_dir, is_file): New function. Actually use result of stat when available. * flower/file-path.cc (find): Use it. Refactor. Fixes Mingw, absolute file name and root. * scm/lily.scm (PLATFORM): On mingw, slashify getcwd. * scm/editor.scm (get-editor-command): Typo: do not apply editor. * flower/file-name.cc (slashify): Bugfix, do substitute if no slashes in file name. --- diff --git a/ChangeLog b/ChangeLog index 3219947bee..3fee7dbd95 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,33 @@ +2005-05-14 Jan Nieuwenhuizen + + * scripts/lilypond-invoke-editor.scm (dissect-uri): Handle URIs + with Windows root in file name. + + * scm/backend-library.scm (ly:system): Only redirect output (using + system and shell, ugh) if /dev/null is writable. + + * Documentation/pictures/GNUmakefile [PLATFORM_WINDOWS]: Build + windows icon. + + * scm/lily.scm (is-absolute?): New function. Fixes absolute files + on Mingw. + + * scm/output-ps.scm (grob-cause): Use it. Fixes PDF point and + click. + + * flower/file-path.cc (is_dir, is_file): New function. Actually + use result of stat when available. + + * flower/file-path.cc (find): Use it. Refactor. Fixes Mingw, + absolute file name and root. + + * scm/lily.scm (PLATFORM): On mingw, slashify getcwd. + + * scm/editor.scm (get-editor-command): Typo: do not apply editor. + + * flower/file-name.cc (slashify): Bugfix, do substitute if no + slashes in file name. + 2005-05-13 Jan Nieuwenhuizen * Documentation/user/preface.itely (Preface): Run diff --git a/Documentation/pictures/GNUmakefile b/Documentation/pictures/GNUmakefile index 30873a98e3..7490fd6a59 100644 --- a/Documentation/pictures/GNUmakefile +++ b/Documentation/pictures/GNUmakefile @@ -6,18 +6,15 @@ OUTGIF_FILES = $(addprefix $(outdir)/,$(XPM_FILES:.xpm=.gif)) OUTPNG_FILES = $(addprefix $(outdir)/,$(XPM_FILES:.xpm=.png)) EXTRA_DIST_FILES= $(XPM_FILES) -OUT_DIST_FILES = $(icon) #$(package-icon) + +ifeq ($(PLATFORM_WINDOWS),yes) +OUT_DIST_FILES = $(icon) # $(package-icon) icon = $(outdir)/lilypond.ico ICON_SIZES=48 32 16 #$(outdir)/lilypond.ico: platte-lucht-kikker-ly-48.xpm -include $(depth)/make/stepmake.make - -default: $(icon) -local-dist: $(icon) # $(package-icon) - $(outdir)/%.ico: $(ICON_SIZES:%=$(outdir)/\%-%.png) $(ICON_SIZES:%=$(outdir)/\%-%-8.png) #convert +adjoin $^ $@ icotool --output=$@ --create $^ @@ -36,9 +33,13 @@ $(outdir)/%-16.png: %-48.xpm $(outdir)/%-8.png: $(outdir)/%.png convert -depth 8 $< $@ +endif # PLATFORM_WINDOWS +include $(depth)/make/stepmake.make + +default: $(icon) +local-dist: $(icon) # $(package-icon) xgifs: $(OUTGIF_FILES) pngs: $(OUTPNG_FILES) - local-WWW: $(OUTPNG_FILES) diff --git a/flower/file-name.cc b/flower/file-name.cc index ac9e6832e0..f4ba75a18f 100644 --- a/flower/file-name.cc +++ b/flower/file-name.cc @@ -54,7 +54,7 @@ dos_to_posix (String file_name) static String slashify (String file_name) { - if (file_name.index ('/')) + if (file_name.index ('/') >= 0) return file_name; file_name.substitute ('\\', '/'); file_name.substitute ("\"", "\\\""); diff --git a/flower/file-path.cc b/flower/file-path.cc index 3711cf7c2f..f8504396cf 100644 --- a/flower/file-path.cc +++ b/flower/file-path.cc @@ -22,6 +22,7 @@ #endif #include "file-name.hh" +#include "warn.hh" #ifndef PATHSEP #define PATHSEP ':' @@ -47,6 +48,54 @@ File_path::parse_path (String p) } } +static bool +is_file (String file_name) +{ +#if 0 /* Check if directory. TODO: encapsulate for autoconf */ + struct stat sbuf; + if (stat (file_name.to_str0 (), &sbuf) != 0) + return false; + + if (!(sbuf.st_mode & __S_IFREG)) + return false; +#endif +#if !STAT_MACROS_BROKEN + struct stat sbuf; + if (stat (file_name.to_str0 (), &sbuf) != 0) + return false; + + return !S_ISDIR (sbuf.st_mode); +#endif + + if (FILE *f = fopen (file_name.to_str0 (), "r")) + { + fclose (f); + return true; + } + + return false; +} + +static bool +is_dir (String file_name) +{ +#if !STAT_MACROS_BROKEN + struct stat sbuf; + if (stat (file_name.to_str0 (), &sbuf) != 0) + return false; + + return S_ISDIR (sbuf.st_mode); +#endif + + if (FILE *f = fopen (file_name.to_str0 (), "r")) + { + fclose (f); + return true; + } + return false; +} + + /** Find a file. Check absolute file name, search in the current dir (DUH! FIXME!), @@ -62,51 +111,24 @@ File_path::find (String name) const if (!name.length () || (name == "-")) return name; +#ifdef __MINGW32__ + if (name[0] == '\\' || (name.length () > 2 && name[2] == '\\')) + programming_error ("file name not normalized: " + name); +#endif /* __MINGW32__ */ + /* Handle absolute file name. */ - if (name[0] == DIRSEP) - { - if (FILE *f = fopen (name.to_str0 (), "r")) - { - fclose (f); - return name; - } - } + File_name file_name (name); + if (file_name.dir_[0] == DIRSEP && is_file (file_name.to_string ())) + return file_name.to_string (); - for (int i = 0; i < size (); i++) + for (int i = 0, n = size (); i < n; i++) { - String file_name = elem (i); - String sep = ::to_string (DIRSEP); - String right (file_name.right_string (1)); - if (file_name.length () && right != sep) - file_name += ::to_string (DIRSEP); - - file_name += name; - -#if 0 /* Check if directory. TODO: encapsulate for autoconf */ - struct stat sbuf; - if (stat (file_name.to_str0 (), &sbuf) != 0) - continue; - - if (! (sbuf.st_mode & __S_IFREG)) - continue; -#endif -#if !STAT_MACROS_BROKEN - - struct stat sbuf; - if (stat (file_name.to_str0 (), &sbuf) != 0) - continue; - - if (S_ISDIR (sbuf.st_mode)) - continue; -#endif - - /* ugh */ - FILE *f = fopen (file_name.to_str0 (), "r"); - if (f) - { - fclose (f); - return file_name; - } + File_name dir = elem (i); + file_name.root_ = dir.root_; + dir.root_ = ""; + file_name.dir_ = dir.to_string (); + if (is_file (file_name.to_string ())) + return file_name.to_string (); } return ""; } @@ -151,9 +173,8 @@ File_path::try_append (String s) { if (s == "") s = "."; - if (FILE *f = fopen (s.to_str0 (), "r")) + if (is_dir (s)) { - fclose (f); append (s); return true; } @@ -164,8 +185,7 @@ String File_path::to_string () const { String s; - int n = size (); - for (int i = 0; i < n; i++) + for (int i = 0, n = size (); i < n; i++) { s = s + elem (i); if (i < n - 1) diff --git a/flower/include/file-path.hh b/flower/include/file-path.hh index f9d9f816cc..3c7cc26461 100644 --- a/flower/include/file-path.hh +++ b/flower/include/file-path.hh @@ -1,5 +1,5 @@ /* - file-path.hh -- declare File_name and File_path + file-path.hh -- declare File_path source file of the Flower Library diff --git a/lily/includable-lexer.cc b/lily/includable-lexer.cc index 540f8de8f4..7cde6bfc37 100644 --- a/lily/includable-lexer.cc +++ b/lily/includable-lexer.cc @@ -133,9 +133,7 @@ Includable_lexer::here_str0 () const Includable_lexer::~Includable_lexer () { while (!include_stack_.is_empty ()) - { - close_input (); - } + close_input (); } Source_file * @@ -143,6 +141,5 @@ Includable_lexer::get_source_file () const { if (include_stack_.is_empty ()) return 0; - else - return include_stack_.top (); + return include_stack_.top (); } diff --git a/lily/main.cc b/lily/main.cc index 7d490d8a6a..eb2f222d17 100644 --- a/lily/main.cc +++ b/lily/main.cc @@ -590,6 +590,12 @@ parse_argv (int argc, char **argv) } } +#ifdef __MINGW32__ +/* If no TTY and not using safe, assume running from GUI. + For mingw, the test must be inverted. */ +# define isatty(x) (!isatty (x)) +#endif + int main (int argc, char **argv) { diff --git a/scm/backend-library.scm b/scm/backend-library.scm index a9367de7c2..5fef767162 100644 --- a/scm/backend-library.scm +++ b/scm/backend-library.scm @@ -10,10 +10,11 @@ (define-public (ly:system command) (let* ((status 0) - (silenced - (string-append command (if (ly:get-option 'verbose) - "" - " > /dev/null 2>&1 ")))) + (dev-null "/dev/null") + (silenced (if (or (ly:get-option 'verbose) + (not (access? dev-null W_OK))) + command + (format #f "~a > ~a 2>&1 " command dev-null)))) (if (ly:get-option 'verbose) (ly:message (_ "Invoking `~a'...") command)) diff --git a/scm/editor.scm b/scm/editor.scm index 4bf560d243..aeea02b615 100644 --- a/scm/editor.scm +++ b/scm/editor.scm @@ -29,7 +29,7 @@ (define (get-command-template alist editor) (if (null? alist) (if (string-match "%\\(file\\)s" editor) - (editor) + editor (string-append editor " %(file)s")) (if (string-match (caar alist) editor) (cdar alist) diff --git a/scm/lily.scm b/scm/lily.scm index 63da7812d9..565a5e3c69 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -77,6 +77,42 @@ (define-public TEX_STRING_HASHLIMIT 10000000) +;; Cygwin +;; #(CYGWIN_NT-5.1 Hostname 1.5.12(0.116/4/2) 2004-11-10 08:34 i686) +;; +;; Debian +;; #(Linux hostname 2.4.27-1-686 #1 Fri Sep 3 06:28:00 UTC 2004 i686) +;; +;; Mingw +;; #(Windows XP HOSTNAME build 2600 5.01 Service Pack 1 i686) +;; +(define PLATFORM + (string->symbol + (string-downcase + (car (string-tokenize (vector-ref (uname) 0) char-set:letter))))) + +(case PLATFORM + ((windows) + (define native-getcwd getcwd) + (define (slashify x) + (if (string-index x #\/) + x + (string-regexp-substitute "\\" "/" x))) + ;; FIXME: this prints a warning. + (define-public (ly-getcwd) + (slashify (native-getcwd)))) + (else (define-public ly-getcwd getcwd))) + +(define-public (is-absolute? file-name) + (let ((file-name-length (string-length file-name))) + (if (= file-name-length 0) + #f + (or (eq? (string-ref file-name 0) #\/) + (and (eq? PLATFORM 'windows) + (> file-name-length 2) + (eq? (string-ref file-name 1) #\:) + (eq? (string-ref file-name 2) #\/)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (type-check-list location signature arguments) @@ -337,21 +373,30 @@ The syntax is the same as `define*-public'." (use-modules (scm editor)) +(define (running-from-gui?) + (let ((have-tty? (isatty? (current-input-port)))) + ;; If no TTY and not using safe, assume running from GUI. + ;; For mingw, the test must be inverted. + (if (eq? PLATFORM 'windows) + have-tty? (not have-tty?)))) + (define-public (gui-main files) (if (null? files) (gui-no-files-handler)) (let* ((base (basename (car files) ".ly")) (log-name (string-append base ".log")) (log-file (open-file log-name "w"))) - ;; Ugh, his opens a terminal - ;; Do this when invoked using --quiet, --log or something? - ;; (ly:message (_ "Redirecting output to ~a...") log-name) + (if (not (running-from-gui?)) + (ly:message (_ "Redirecting output to ~a...") log-name)) (ly:port-move (fileno (current-error-port)) log-file) (ly:message "# -*-compilation-*-") - (if (null? (lilypond-all files)) - (exit 0) - (begin - (system (get-editor-command log-name 0 0)) - (exit 1))))) + (let ((failed (lilypond-all files))) + (if (pair? failed) + (begin + (system (get-editor-command log-name 0 0)) + (ly:error (_ "failed files: ~S") (string-join failed)) + ;; not reached? + (exit 1)) + (exit 0))))) (define (gui-no-files-handler) (let* ((ly (string-append (ly:effective-prefix) "/ly/")) @@ -362,7 +407,6 @@ The syntax is the same as `define*-public'." (system cmd) (exit 1))) -;; If no TTY and not using safe, assume running from GUI. -(or (isatty? (current-input-port)) +(or (not (running-from-gui?)) (ly:get-option 'safe) (define lilypond-main gui-main)) diff --git a/scm/output-ps.scm b/scm/output-ps.scm index aa6581adf4..cc021b8423 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -106,18 +106,17 @@ (list arch_angle arch_width arch_height height arch_thick thick)) " draw_bracket")) +(define (char font i) + (string-append + (ps-font-command font) " setfont " + "(\\" (ly:inexact->string i 8) ") show")) + (define (circle radius thick fill) (format "~a ~a ~a draw_circle" radius thick (if fill "true " - "false ") - )) - -(define (char font i) - (string-append - (ps-font-command font) " setfont " - "(\\" (ly:inexact->string i 8) ") show")) + "false "))) (define (dashed-line thick on off dx dy) (string-append @@ -204,10 +203,9 @@ "" (let* ((location (ly:input-file-line-column music-origin)) (raw-file (car location)) - (file (if (and (> (string-length raw-file) 0) - (eq? (string-ref raw-file 0) #\/)) + (file (if (is-absolute? raw-file) raw-file - (string-append (getcwd) "/" raw-file))) + (string-append (ly-getcwd) "/" raw-file))) (x-ext (ly:grob-extent grob grob X)) (y-ext (ly:grob-extent grob grob Y))) diff --git a/scripts/lilypond-invoke-editor.scm b/scripts/lilypond-invoke-editor.scm index 81cf6f0a4e..26e7e364a4 100755 --- a/scripts/lilypond-invoke-editor.scm +++ b/scripts/lilypond-invoke-editor.scm @@ -9,7 +9,9 @@ (use-modules (ice-9 getopt-long) - (ice-9 regex)) + (ice-9 regex) + (srfi srfi-13) + (srfi srfi-14)) (define PROGRAM-NAME "lilypond-invoke-editor") (define TOPLEVEL-VERSION "@TOPLEVEL_VERSION@") @@ -57,20 +59,42 @@ Options: (define (dissect-uri uri) (let* ((ri "textedit://") (file-name:line:column (re-sub ri "" uri)) - (match (string-match "([^:]+):([^:]+):(.*)" file-name:line:column))) + (match (string-match "(.*):([^:]+):(.*)$" file-name:line:column))) (if match (list (match:substring match 1) (match:substring match 2) (match:substring match 3)) (begin + ;; FIXME: why be so strict wrt :LINE:COLUMN, + ;; esp. considering omitting textedit:// is explicitly + ;; allowed. (format (current-error-port) (_ "invalid URI: ~a") uri) (newline (current-error-port)) (format (current-error-port) (_ "expect: ~aFILE:LINE:COLUMN") ri) (newline (current-error-port)) (exit 1))))) - + +(define PLATFORM + (string->symbol + (string-downcase + (car (string-tokenize (vector-ref (uname) 0) char-set:letter))))) + +(define (running-from-gui?) + (let ((have-tty? (isatty? (current-input-port)))) + ;; If no TTY and not using safe, assume running from GUI. + ;; for mingw, the test must be inverted. + (if (eq? PLATFORM 'windows) + have-tty? (not have-tty?)))) + (define (main args) (let ((files (parse-options args))) + (if (running-from-gui?) + (redirect-port (current-error-port) + (open-file (string-append + (or (getenv "TMP") + (getenv "TEMP") + "/tmp") + "/lilypond-invoke-editor.log") "a"))) (if (not (= (length files) 1)) (begin (show-help (current-error-port))