* scm/lily.scm (gui-main): Use it.
* scm/framework-gnome.scm (spawn-editor): Use it.
* scripts/lilypond-invoke-editor.scm: Use it in new script.
+2005-05-10 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * scm/editor.scm: New module.
+
+ * scm/lily.scm (gui-main): Use it.
+
+ * scm/framework-gnome.scm (spawn-editor): Use it.
+
+ * scripts/lilypond-invoke-editor.scm: Use it in new script.
+
2005-05-10 Han-Wen Nienhuys <hanwen@xs4all.nl>
* scm/framework-ps.scm (load-font-via-GS): new function.
* scripts/lilypond-pdfpc-helper.py (ly_pc_editor): robustness fixes.
-2005-05-10 Jan Nieuwenhuizen <janneke@gnu.org>
-
* scm/backend-library.scm (postscript->pdf): Invoke gs instead of
going through ps2pdf wrappers.
return scm_makfrom0str (prefix_directory.to_str0 ());
}
-
-
LY_DEFINE (ly_chain_assoc_get, "ly:chain-assoc-get",
2, 1, 0, (SCM key, SCM achain, SCM dfault),
"Return value for @var{key} from a list of alists @var{achain}. Return @var{dfault} "
else
return dfault == SCM_UNDEFINED ? SCM_BOOL_F : dfault;
}
+
+LY_DEFINE (ly_port_move, "ly:port-move",
+ 2, 0, 0, (SCM fd, SCM port),
+ "Move file descriptor FD to PORT.")
+{
+ SCM_ASSERT_TYPE (scm_port_p (port), port, SCM_ARG1, __FUNCTION__, "port");
+ SCM_ASSERT_TYPE (scm_integer_p (fd), fd, SCM_ARG1, __FUNCTION__, "fd");
+ freopen (ly_scm2newstr (scm_port_filename (port), 0), "a",
+ fdopen (scm_to_int (fd), "a"));
+ return SCM_UNSPECIFIED;
+}
--- /dev/null
+;;;; editor.scm --
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2005 Jan Nieuwenhuizen <janneke@gnu.org>
+
+(define-module (scm editor))
+
+(use-modules
+ (ice-9 regex))
+
+(define editor-command-template-alist
+ '(("emacs" . "emacsclient --no-wait +%(line)s:%(column)s %(file)s")
+ ("gvim" . "gvim --remote +:%(line)s:norm%(column)s %(file)s")
+ ("nedit" . "nc -noask +%(line)s %(file)s")
+ ("gedit" . "gedit +%(line)s %(file)s")
+ ("jedit" . "jedit %(file)s +line:%(line)s")))
+
+(define (get-editor)
+ (or (getenv "LYEDITOR")
+ (getenv "XEDITOR")
+ (getenv "EDITOR")
+ "emacs"))
+
+(define (re-sub re sub string)
+ (regexp-substitute/global #f re string 'pre sub 'post))
+
+(define-public (get-editor-command file-name line column)
+ (define (get-command-template alist editor)
+ (if (null? alist)
+ #f
+ (if (string-match (caar alist) editor)
+ (cdar alist)
+ (get-command-template (cdr alist) editor))))
+
+ (let* ((editor (get-editor))
+ (template (get-command-template editor-command-template-alist editor))
+ (command
+ (re-sub "%\\(file\\)s" (format #f "~S" file-name)
+ (re-sub "%\\(line\\)s" (format #f "~a" line)
+ (re-sub "%\\(column\\)s" (format #f "~a" column)
+ template)))))
+ command))
(add (scrolled go) (canvas go))
(show (canvas go)))))
-(define x-editor #f)
-(define (get-x-editor)
- (if (not x-editor)
- (set! x-editor (getenv "XEDITOR")))
- x-editor)
-
(define ifs #f)
(define (get-ifs)
(if (not ifs)
(let* ((file-name (car location))
(line (cadr location))
(column (caddr location))
- (template (substring (get-x-editor) 0))
-
- ;; Adhere to %l %c %f?
- (command
- (regexp-substitute/global
- #f "%l" (regexp-substitute/global
- #f "%c"
- (regexp-substitute/global
- #f "%f" template 'pre file-name 'post)
- 'pre (number->string column)
- 'post)
- 'pre (number->string line) 'post)))
-
+ (command (get-editor-command file line column)))
(debugf "spawning: ~s\n" command)
(if (= (primitive-fork) 0)
(let ((command-list (string-split command #\ )));; (get-ifs))))
(cons x (cons between y))))
(fold-right conc #f lst))
-
(define-public (string-regexp-substitute a b str)
(regexp-substitute/global #f a str 'pre b 'post))
(ice-9 safe)
(ice-9 optargs)
(oop goops)
- (srfi srfi-1) ; lists
- (srfi srfi-13)) ; strings
+ (srfi srfi-1) ;; lists
+ (srfi srfi-13)) ;; strings
;; my display
protects))
outfile)))
+(define-public (tweak-grob-property grob sym val)
+ (set! (ly:grob-property grob sym) val))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (no-files-handler)
- (ly:usage)
- (exit 2))
-
(define-public (lilypond-main files)
"Entry point for LilyPond."
(if (null? files)
(no-files-handler))
- (let* ((failed '())
- (handler (lambda (key failed-file)
- (set! failed (append (list failed-file) failed)))))
- ;;(handler (lambda (key . arg) (set! failed (append arg failed)))))
- (for-each
- (lambda (f)
- (catch 'ly-file-failed
- (lambda () (ly:parse-file f))
- (lambda (x . args) (handler x f)))
- ;;(lambda (x) (handler x f)))
- (if #f
- (dump-gc-protects)))
- files)
-
+ (let ((failed (lilypond-all files)))
(if (pair? failed)
(begin
(ly:error (_ "failed files: ~S") (string-join failed))
(ly:message "")
(exit 0)))))
-(define-public (tweak-grob-property grob sym val)
- (set! (ly:grob-property grob sym) val))
+(define (no-files-handler)
+ (ly:usage)
+ (exit 2))
+
+(define-public (lilypond-all files)
+ (let* ((failed '())
+ (handler (lambda (key failed-file)
+ (set! failed (append (list failed-file) failed)))))
+ ;;(handler (lambda (key . arg) (set! failed (append arg failed)))))
+ (for-each (lambda (x) (lilypond-file handler x)) files)))
+
+(define (lilypond-file handler file-name)
+ (catch 'ly-file-failed
+ (lambda () (ly:parse-file file-name))
+ (lambda (x . args) (handler x file-name)))
+ ;;(lambda (x) (handler x f)))
+ (if #f
+ (dump-gc-protects)))
+
+(use-modules (scm editor))
+
+(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")))
+ (display "# -*-compilation-*-" log-file)
+ (newline log-file)
+ (ly:message (_ "Redirecting output to ~a...") log-name)
+ (ly:port-move (fileno (current-error-port)) log-file)
+ (if (null? (lilypond-all files))
+ (exit 0)
+ (begin
+ (system (get-editor-command log-name 0 0))
+ (exit 1)))))
+
+(define (gui-no-files-handler)
+ (let* ((input (string-append
+ (string-regexp-substitute
+ "share/lilypond/" "share/doc/lilypond-"
+ (getenv "LILYPONDPREFIX"))
+ "-1/input"))
+ (ly (string-append input "/" "Welcome to LilyPond.ly"))
+ (cmd (get-editor-command ly 0 0)))
+ (system cmd)))
+
+;; FIXME
+;; (define lilypond-main gui-main)
--- /dev/null
+#!@GUILE@ \
+-e main -s
+!#
+;;;; lilypond-invoke-editor.scm -- Invoke an editor in file:line:column mode
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2005 Jan Nieuwenhuizen <janneke@gnu.org>
+
+(use-modules
+ (ice-9 getopt-long)
+ (ice-9 regex))
+
+(define PROGRAM-NAME "lilypond-invoke-editor")
+(define TOPLEVEL-VERSION "@TOPLEVEL_VERSION@")
+(define DATADIR "@DATADIR@")
+(define COMPILE-TIME-PREFIX
+ (format #f "~a/lilypond/~a" DATADIR TOPLEVEL-VERSION))
+(define LILYPONDPREFIX (or (getenv "LILYPONDPREFIX") COMPILE-TIME-PREFIX))
+
+;; gettext wrapper for guile < 1.7.2
+(if (defined? 'gettext)
+ (define-public _ gettext)
+ (define-public (_ x) x))
+
+(define (show-version port)
+ (format port "~a (GNU LilyPond) ~a \n" PROGRAM-NAME TOPLEVEL-VERSION))
+
+(define (show-help port)
+ (format port (_ "Usage: lilypond-invoke-editor [textedit://]FILE:LINE:COLUMN
+
+Visit a file and position the cursor
+
+Options:
+ -h,--help show this help
+ -v,--version show version
+")))
+
+(define (parse-options args)
+ (let* ((options (getopt-long args
+ '((help (single-char #\h))
+ (version (single-char #\v)))))
+ (files (cdr (assq '() options))))
+ (if (assq 'help options)
+ (begin
+ (show-version (current-output-port))
+ (show-help (current-output-port))
+ (exit 0)))
+ (if (assq 'version options)
+ (begin (show-version (current-output-port)) (exit 0)))
+ (show-version (current-error-port))
+ files))
+
+(define (re-sub re sub string)
+ (regexp-substitute/global #f re string 'pre sub 'post))
+
+(define (dissect-uri uri)
+ (let* ((ri "textedit://")
+ (file-name:line:column (re-sub ri "" uri))
+ (match (string-match "([^:]+):([^:]+):(.*)" file-name:line:column)))
+ (if match
+ (list (match:substring match 1)
+ (match:substring match 2)
+ (match:substring match 3))
+ (begin
+ (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 (main args)
+ (let ((files (parse-options args)))
+ (if (not (= (length files) 1))
+ (begin
+ (show-help (current-error-port))
+ (exit 1)))
+ (set! %load-path (cons LILYPONDPREFIX %load-path))
+ (primitive-eval '(use-modules (scm editor)))
+ (let* ((uri (car files))
+ (command (apply get-editor-command (dissect-uri uri)))
+ (status (system command)))
+ (if (not (= status 0))
+ (begin
+ (format (current-error-port)
+ (_ "failed to invoke editor: ~a") command)
+ (exit 1))))))
projects / lilypond.git / commitdiff