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-14 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * 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 <janneke@gnu.org>
* Documentation/user/preface.itely (Preface): Run
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 $^
$(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)
static String
slashify (String file_name)
{
- if (file_name.index ('/'))
+ if (file_name.index ('/') >= 0)
return file_name;
file_name.substitute ('\\', '/');
file_name.substitute ("\"", "\\\"");
#endif
#include "file-name.hh"
+#include "warn.hh"
#ifndef PATHSEP
#define PATHSEP ':'
}
}
+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!),
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 "";
}
{
if (s == "")
s = ".";
- if (FILE *f = fopen (s.to_str0 (), "r"))
+ if (is_dir (s))
{
- fclose (f);
append (s);
return true;
}
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)
/*
- file-path.hh -- declare File_name and File_path
+ file-path.hh -- declare File_path
source file of the Flower Library
Includable_lexer::~Includable_lexer ()
{
while (!include_stack_.is_empty ())
- {
- close_input ();
- }
+ close_input ();
}
Source_file *
{
if (include_stack_.is_empty ())
return 0;
- else
- return include_stack_.top ();
+ return include_stack_.top ();
}
}
}
+#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)
{
(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))
(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)
(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)
(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/"))
(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))
(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
""
(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)))
(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@")
(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))
projects / lilypond.git / commitdiff