From a5a4028d46d8ff4c9f35b3c8f3ed510b120cbd95 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 10 May 2005 21:58:45 +0000 Subject: [PATCH] * 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. --- ChangeLog | 12 ++++- lily/general-scheme.cc | 13 ++++- scm/editor.scm | 43 +++++++++++++++ scm/framework-gnome.scm | 20 +------ scm/lily-library.scm | 1 - scm/lily.scm | 76 ++++++++++++++++++-------- scripts/lilypond-invoke-editor.scm | 87 ++++++++++++++++++++++++++++++ 7 files changed, 205 insertions(+), 47 deletions(-) create mode 100644 scm/editor.scm create mode 100755 scripts/lilypond-invoke-editor.scm diff --git a/ChangeLog b/ChangeLog index d76ade4eff..350ec15988 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2005-05-10 Jan Nieuwenhuizen + + * 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 * scm/framework-ps.scm (load-font-via-GS): new function. @@ -18,8 +28,6 @@ * scripts/lilypond-pdfpc-helper.py (ly_pc_editor): robustness fixes. -2005-05-10 Jan Nieuwenhuizen - * scm/backend-library.scm (postscript->pdf): Invoke gs instead of going through ps2pdf wrappers. diff --git a/lily/general-scheme.cc b/lily/general-scheme.cc index ffe6875d63..11fb65790f 100644 --- a/lily/general-scheme.cc +++ b/lily/general-scheme.cc @@ -277,8 +277,6 @@ LY_DEFINE (ly_effective_prefix, "ly:effective-prefix", 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} " @@ -295,3 +293,14 @@ LY_DEFINE (ly_chain_assoc_get, "ly:chain-assoc-get", 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; +} diff --git a/scm/editor.scm b/scm/editor.scm new file mode 100644 index 0000000000..962627941a --- /dev/null +++ b/scm/editor.scm @@ -0,0 +1,43 @@ +;;;; editor.scm -- +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2005 Jan Nieuwenhuizen + +(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)) diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm index fb492474b8..d8a9699c36 100644 --- a/scm/framework-gnome.scm +++ b/scm/framework-gnome.scm @@ -166,12 +166,6 @@ (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) @@ -184,19 +178,7 @@ (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)))) diff --git a/scm/lily-library.scm b/scm/lily-library.scm index cd8b72cafb..3f77e9a174 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -304,7 +304,6 @@ possibly turned off." (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)) diff --git a/scm/lily.scm b/scm/lily.scm index b420e3152c..31d482a17e 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -15,8 +15,8 @@ (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 @@ -295,33 +295,17 @@ The syntax is the same as `define*-public'." 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)) @@ -331,5 +315,51 @@ The syntax is the same as `define*-public'." (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) diff --git a/scripts/lilypond-invoke-editor.scm b/scripts/lilypond-invoke-editor.scm new file mode 100755 index 0000000000..81cf6f0a4e --- /dev/null +++ b/scripts/lilypond-invoke-editor.scm @@ -0,0 +1,87 @@ +#!@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 + +(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)))))) -- 2.39.2