diff --git a/ChangeLog b/ChangeLog index eadaaf3..daf58b0 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2008-08-03 Niels Giesen + + * gimp-mode.el (gimp-comint-filter): add prettification to output + of the GIMP. + + * fud.scm: add stepping inside and function instruction. + + * fud.el: add fud-bullet bitmap to show breakpoints. + + * gimp-mode.el (gimp-open-image): changed order so that message is + not put in the *GIMP* buffer. + 2008-08-01 Niels Giesen * gimp-mode.el (gimp-completion-rules): enhance rule for palettes diff --git a/THOUGHTS b/THOUGHTS index 6f6d58a..60f194c 100755 --- a/THOUGHTS +++ b/THOUGHTS @@ -60,5 +60,77 @@ dolist (db-recurse body*))) +Actually, I do not think instructing beforehand is good, better do it +lazily: let fud-break give you the option to step inside, upon which +all immediate subforms that can handle it are instructed with a +fud-break spec. + +So, on fud-break + step-inside: + +(fud-break "" + (let ((behold 1)) + 1 (mapcar (lambda () ..) '(129 304)))) => + +(let ((behold (fud-break "" 1))) + (fud-break 1) + (fud-break (mapcar (lambda () ..) '(129 304)))) ;lazy + +(define (fud-instruct sxp) + (mapcar + (lambda (sxp) + ))) + + +thus: + +(let ((in-let #f)) + (mapcar (lambda (th) + (cond ((memq th '(let)) + (begin + (set! in-let #t) + th)) + (in-let + (if (symbol? th) th + (begin + (set! in-let #f) + (mapcar (lambda (th) + (list (car th) + (fud-breakify (cadr th)))) th)))) + (else + (fud-breakify th)))) + '(let loop ((behold 4)) + 1 + (mapcar (lambda (b) (+ n 19)) '(129 304))))) + +(define (fud-instruct-1 thunk) + (let ((in-let #f) + (in-lambda #f) + (num 0)) + (mapcar (lambda (th) + (set! num (+ 1 num)) + (cond ((and (= num 1) + (memq th '(let))) + (set! in-let #t) + th) + (in-let ;special let rule + (if (symbol? th) th + (begin + (set! in-let #f) + (mapcar (lambda (th) + (list (car th) + (fud-breakify (cadr th)))) th)))) + ((and (= num 1) + (memq th '(lambda))) + (set! in-lambda #t) + 'lambda) + (in-lambda ;simple lambda rule + (set! in-lambda #f) + th) + (else + (fud-breakify th)))) + thunk))) + +ranking system for completions according to number of times chosen/being part of the +language. diff --git a/emacs-interaction.scm b/emacs-interaction.scm index 9b3e9ad..d4b8337 100644 --- a/emacs-interaction.scm +++ b/emacs-interaction.scm @@ -1,5 +1,5 @@ ;; -*- mode: Gimp; -*- -;;; emacs-interaction.scm --- $Id: emacs-interaction.scm,v 1.21 2008-07-24 09:05:14 sharik Exp $ +;;; emacs-interaction.scm --- $Id: emacs-interaction.scm,v 1.22 2008-08-03 16:03:49 sharik Exp $ ;; Copyright (C) 2008 Niels Giesen. ;; Author: Niels Giesen 241.58 [[ file:/home/sharik/.emacs.d/gimp/fud.scm ]]") - t - "FAILED fud-reference-in-string in step in-string") + (fud-reference-in-string "Break I-> 241.58 [[ file:/home/sharik/.emacs.d/gimp/fud.scm ]]")) (assert (fud-reference-in-string "Break I-> 241.58 [[ file:nil ]]")) (assert (fud-echo-value " I: (spaces->underscores \"13091q wekjq wejkoiqp wejqwe qwek op123\")")) diff --git a/fud.scm b/fud.scm index 4ba72b9..9668e44 100644 --- a/fud.scm +++ b/fud.scm @@ -1,64 +1,86 @@ ;; -*- mode: gimp; -*- -(define fud-last-result #f) +;; Copyright (C) 2008 Niels Giesen + +;; Author: Niels Giesen +;; Keywords: lisp, tools, scheme, debugging + +;; This file 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, or (at your option) +;; any later version. + +;; This file 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. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; FUD stands for the FU Unified Debugger. +;; +;; It's basis is handling break-points set interactively through +;; another breakpoint, or by use of fud.el with Emacs, which is +;; integrated in gimp-mode. + +;; (define fud-last-result #f) ;; (define-macro (fud . x) ;; (fud-trace) -;; `(call/cc (lambda (k) -;; ; (push-handler fud-handler) -;; ,@x))) - -(define-macro (fud . x) - (fud-trace) - `(prog1 - (call/cc - (lambda (exit) - (push-handler (lambda (e) - (exit e))) - ,@x)) - (fud-trace))) - -(define-macro (fudr) - (fud-trace) +;; `(prog1 +;; (call/cc +;; (lambda (exit) +;; (push-handler (lambda (e) +;; (exit e))) +;; ,@x)) +;; (fud-trace))) + +;; (define-macro (fudr) +;; (fud-trace) - `(prog1 - (display "FUD> ") - (let - ((result - (call/cc - (lambda (exit) - (push-handler (lambda (e) - (display e) - (exit e))) - (let ((res (eval (read)))) - (print res) - res))))) -;; (pop-handler) -;; (display result) - (unless (eq? result 'fud-quit) - (fudr))))) - -(define (fud-repl) - (newline) - (catch (fud-repl) - (display "FUD> ") - (print (eval (fud(read)))) - (fud-repl))) +;; `(prog1 +;; (display "FUD> ") +;; (let +;; ((result +;; (call/cc +;; (lambda (exit) +;; (push-handler (lambda (e) +;; (display e) +;; (exit e))) +;; (let ((res (eval (read)))) +;; (print res) +;; res))))) +;; ;; (pop-handler) +;; ;; (display result) +;; (unless (eq? result 'fud-quit) +;; (fudr))))) + +;; (define (fud-repl) +;; (newline) +;; (catch (fud-repl) +;; (display "FUD> ") +;; (print (eval (fud(read)))) +;; (fud-repl))) (define (fud-prompt) (newline) (fud-write-string "FUD> ")) -(define (fud-handler x) - (set! fud-last-result x) - (display (string-append "Error: " x)) - (newline) - (display "Use value (V) / Abort (A) ") - (let ((c (read-char))) - (cond ((char-ci=? c #\v) - (push-handler fud-handler) - (read)) - ((char-ci=? c #\a) - (throw x))))) +;; (define (fud-handler x) +;; (set! fud-last-result x) +;; (display (string-append "Error: " x)) +;; (newline) +;; (display "Use value (V) / Abort (A) ") +;; (let ((c (read-char))) +;; (cond ((char-ci=? c #\v) +;; (push-handler fud-handler) +;; (read)) +;; ((char-ci=? c #\a) +;; (throw x))))) (define fud-result #f) @@ -89,72 +111,17 @@ (define (fud-trace) (set! fud-tracing #t)) -;; (define-macro (fud-break line . form) -;; `(begin -;; (when fud-tracing -;; (newline)) -;; (fud-recursion++) -;; (when fud-tracing -;; (fud-write-string -;; (if (number? ,line) -;; (string-append "Break at Line " -;; (number->string ,line) -;; ": \n") -;; ,line)) -;; (fud-write-string "I: ") -;; (display (car ',form))) -;; (prog1 -;; (let (($ (eval (car ',form)))) -;; (when fud-tracing -;; (newline) -;; (fud-write-string "O: ") -;; (display $) -;; (newline) -;; (fud-write-string -;; "ENTER: go on to next breakpoint, " -;; " Q: quit," -;; " G: go (skipping breakpoints)," -;; " I: inspect environment," -;; " V: use value") -;; (fud-prompt) -;; (let ((c (read-char))) -;; (cond -;; ;; Go... -;; ((char-ci=? c #\g) -;; (display "Continued... (fud-trace) to trace again") -;; (newline) -;; (fud-untrace)) -;; ;; Quit... -;; ((char-ci=? c #\q) -;; (fud-reset) -;; (*error-hook* (make-environment))) -;; ;; Inspect... -;; ((char-ci=? c #\i) -;; (letrec ((handler (lambda (err) -;; (display err) ""))) -;; (display "Expression (q to quit inspection) current value is bound to `$': ") -;; (fud-prompt) -;; (let loop ((expr (read))) -;; (cond ((eqv? 'q expr)) -;; (;(catch "threw an error" (display (eval expr))) -;; (push-handler handler) -;; (fud-write-string "") -;; (display (eval expr)) -;; (if (and (pair? *handlers*) -;; (eq? handler (car *handlers*))) -;; (pop-handler)) -;; (newline) -;; (fud-write-string "Type expression: ") -;; (fud-prompt) -;; (loop (read))))))) -;; ;; Use value... -;; ((char-ci=? c #\v) -;; (fud-write-string "Enter value: ") -;; (fud-prompt) -;; (set! $ (read)))))) -;; (fud-recursion--) -;; $)))) +(define (fud-inside-steppable? form) + (list? form)) +(define-macro (fud-log . form) + "Very simple logging." + `(let ((evalled (eval (car ',form)))) + (newline) + (display "FUD log on") + (display evalled) + (newline) + evalled)) (define-macro (fud-break breakpoint . form) `(begin @@ -171,51 +138,62 @@ (newline) (fud-write-string "ENTER: step over, " + (if (fud-inside-steppable? (car ',form)) + " I: step inside" "") " Q: quit," - " G: go (skipping further breakpoints)," - " I: inspect environment," + " G: go" + " P: poke at environment," " V: use value") (fud-prompt) - (prog1 (call/cc (lambda (return) - (let ((c (read-char))) - (cond - ;; Go... - ((char-ci=? c #\g) - (display "Continued... (fud-trace) to trace again") - (newline) - (return (eval (car ',form)))) - ;; Quit... - ((char-ci=? c #\q) - (fud-reset) - (*error-hook* "Quit tracing")) - ;; Inspect... - ((char-ci=? c #\i) - (letrec ((handler (lambda (err) - (display err) ""))) - (display "Expression (q to quit inspection): ") + (let (($ #f)) + + ;; INPUT + (case (char-downcase (read-char)) + ;; Go... + ((#\s) + (display "Continued... (fud-trace) to trace again") + (newline) + (return (eval (car ',form)))) + ;; Inside... + ((#\i) + (read-char) + (if (fud-inside-steppable? (car ',form)) + (set! $ (eval (fud-instruct-1 (car ',form)))))) + ;; Quit... + ((#\q) + (fud-reset) + (*error-hook* "Quit tracing")) + ;; Inspect... + ((#\p) + (letrec ((handler (lambda (err) + (display err) ""))) + (display "Expression (q to quit inspection): ") + (fud-prompt) + (let loop ((expr (read))) + (cond ((eqv? 'q expr)) + ((push-handler handler) + (fud-write-string "") + (write (eval expr)) + (if (and (pair? *handlers*) + (eq? handler (car *handlers*))) + (pop-handler)) + (newline) + (fud-write-string "Type expression: ") + (fud-prompt) + (loop (read))))))) + ;; Use value... + ((#\v) + (read-char) + (fud-write-string "Enter value: ") (fud-prompt) - (let loop ((expr (read))) - (cond ((eqv? 'q expr)) - ((push-handler handler) - (fud-write-string "") - (write (eval expr)) - (if (and (pair? *handlers*) - (eq? handler (car *handlers*))) - (pop-handler)) - (newline) - (fud-write-string "Type expression: ") - (fud-prompt) - (loop (read))))))) - ;; Use value... - ((char-ci=? c #\v) - (fud-write-string "Enter value: ") - (fud-prompt) - (return (read))))) - - (let (($ (eval (car ',form)))) + (set! $ (eval (read))) + (read-char))) + + ;; OUTPUT + (let (($ (or $ (eval (car ',form))))) (when fud-tracing (fud-write-string @@ -232,30 +210,29 @@ "ENTER: next breakpoint, " " Q: quit," " G: go (skipping breakpoints)," - " I: inspect environment," + " P: poke at environment," " V: use value") (fud-prompt) - (let ((c (read-char))) - (cond + + (case (char-downcase (read-char)) ;; Go... - ((char-ci=? c #\g) + ((#\g) (display "Continued... (fud-trace) to trace again") (newline) (fud-untrace)) ;; Quit... - ((char-ci=? c #\q) + ((#\q) (fud-reset) (*error-hook* (make-environment))) ;; Inspect... - ((char-ci=? c #\i) + ((#\p) (letrec ((handler (lambda (err) (display err) ""))) (display "Expression (q to quit inspection) current value is bound to `$': ") (fud-prompt) (let loop ((expr (read))) (cond ((eqv? 'q expr)) - (;(catch "threw an error" (display (eval expr))) - (push-handler handler) + ((push-handler handler) (fud-write-string "") (write (eval expr)) (if (and (pair? *handlers*) @@ -266,13 +243,245 @@ (fud-prompt) (loop (read))))))) ;; Use value... - ((char-ci=? c #\v) + ((#\v) (fud-write-string "Enter value: ") (fud-prompt) - (return (read))) - (else (return $)))) - (return $))))) - (fud-recursion--)))) + (return (eval (read)))) + (else (return $))) + (return $)))))) + (fud-recursion--) + (if (= fud-recursion 0) + (fud-trace))))) + +(define (fud-breakify sxp) + "Return SXP embedded in a FUD breakpoint instruction." + (list 'fud-break "0.0 file:nil" sxp)) + +(define (fud-instruct-1 thunk) + "Instruct evaluatable members of THUNK with `fud-breakify'. + +Special forms and macros supported are if, cond, let, let*, letrec, do +and lambda. Forms BEGINNING with a symbol in `blacklist' are returned +as is. + +FOr instruction of functions, see `fudify' and `unfud'." + (let ((in-let? #f) + (in-lambda? #f) + (in-do? #f) + (in-cond? #f) + (blacklist '(define define-macro)) + (blacklisted? #f) + (num 0)) + (if (eq? (car thunk) 'quote) + (cdr thunk)) + (mapcar (lambda (th) + (set! num (+ 1 num)) + (cond + ;; IF + ((and (= num 1) + (memq th '(if))) + th) + ;; COND + ((and (= num 1) + (memq th '(cond))) + (set! in-cond? #t) + 'cond) + (in-cond? + (mapcar (lambda (clause) + (fud-breakify clause)) th)) + ;; LET, LET* and LETREC + ((and (= num 1) + (memq th '(let let* letrec))) + (set! in-let? #t) + th) + (in-let? + (if (symbol? th) th + (begin + (set! in-let? #f) + (mapcar (lambda (th) + (list (car th) + (fud-breakify (cadr th)))) th)))) + ;; DO + ((and (= num 1) + (memq th '(do))) + (set! in-do? 'bindings) + th) + ((eq? in-do? 'bindings) + (if (symbol? th) th + (begin + (set! in-do? 'test) + (mapcar (lambda (th) + (cond ((= (length th) 2) + (list (car th) + (fud-breakify (cadr th)))) + ((= (length th) 3) + (list (car th) + (fud-breakify (cadr th)) + (fud-breakify (caddr th)))))) + th)))) + ((eq? in-do? 'test) + (set! in-do? #f) + (list (car th) + (fud-breakify (cadr th)))) + ;; LAMBDA + ((and (= num 1) + (memq th '(lambda))) + (set! in-lambda? #t) + 'lambda) + (in-lambda? + (set! in-lambda? #f) + th) + ;; BLACKLISTED FORMS + ((or blacklisted? + (and (= num 1) + (memq th blacklist))) + (set! blacklisted? #t) + th) + (else + (fud-breakify th)))) + thunk))) + +;; Instruction of functions: +(define (delete item lst) + (let + ((out + '())) + (map + (lambda + (item-in-list) + (if + (not + (equal? item item-in-list)) + (set! out + (cons item-in-list out)))) + lst) + (if + (pair? out) + (reverse out)))) + + +(define fudlist + '()) + +(define-macro (fudify f) +"Instruct a function for debugging; + +Any subsequent call to function F will cause fud-breaks to occur at +any immediate sublevel of F. Remove the instruction with (unfud +FUNTION). + +Any redefinition will uninstruct the function. This will give you the +error `Function is already fudified' if after that you want to fudify +it again. Client agents can to some intercepting to make this +automatic." + (let + ((name f)) + `(begin + (if + (assq ',name fudlist) + (error + (string-append + (symbol->string ',f) + " is already fudified"))) + (set! fudlist + (cons + (list ',name + (get-closure-code ,f)) + fudlist)) + (define ,f + (eval + (fud-instruct-1 + (get-closure-code ,f))))))) + +(define-macro (unfud f) + "Remove instruction by fudify on function F" + (let + ((name f)) + `(begin + (if + (not + (assq ',name fudlist)) + (error + (string-append + (symbol->string ',f) + " is not fudified"))) + (define ,f + (eval + (cadr + (assq ',name fudlist)))) + (set! fudlist + (delete + (assq ',name fudlist) + fudlist)) + ',name))) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ;; (define-macro (fud . x) @@ -323,4 +532,4 @@ ;; (exit (apply ,(cadr form) ,err)))) ;; (let ((,label (begin ,@(cddr form)))) ;; (pop-handler) -;; ,label)))))) \ No newline at end of file +;; ,label)))))) diff --git a/gimp-mode.el b/gimp-mode.el index a4296a8..b33b812 100644 --- a/gimp-mode.el +++ b/gimp-mode.el @@ -1,4 +1,4 @@ -;;; gimp-mode.el --- $Id: gimp-mode.el,v 1.46 2008-08-01 17:38:06 sharik Exp $ +;;; gimp-mode.el --- $Id: gimp-mode.el,v 1.47 2008-08-03 16:03:49 sharik Exp $ ;; Copyright (C) 2008 Niels Giesen ;; Author: Niels Giesen ?')) - (when (memq (char-syntax (char-before)) '(?\))) - (backward-sexp 1) - t))) - (forward-char -1))) - (prog1 - ;; Return nil if current word is inside a string. - (if - (or - (= (or (char-after (1- (point))) 0) ?\") - (bobp) - (< 47 (char-after)) -;or at beginning of buffer - nil - (gimp-current-symbol)) - (goto-char p)))))) - -(defun gimp-fnsym-in-current-sexp () - (let ((p (point))) (when (not (looking-back ",[[:alnum:]- ]+")) (with-syntax-table scheme-mode-syntax-table (while @@ -1326,7 +1291,7 @@ buffer, is found." ;hence no symbol. nil (gimp-current-symbol)) - (goto-char p))))) + (goto-char p)))))) (defun gimp-position () "Return position of point in current lambda form." @@ -2162,7 +2127,11 @@ Optional argument LST specifies a list of completion candidates." (scroll-up)))) ;; Do completion. (multiple-value-bind (beg end pattern) (gimp-current-arg) - (let* ((lst (or lst gimp-oblist-cache)) + (let* ((lst (mapcar (lambda (i) + (if (listp i) + (car i) + i)) ;let the list be possibly of form ((matchable . metadata)) + (or lst gimp-oblist-cache))) (completion (if (not gimp-complete-fuzzy-p) (try-completion pattern lst nil) @@ -2209,8 +2178,7 @@ Optional argument LST specifies a list of completion candidates." (delete-region beg end) (insert (car lst2)))))) (unless minibuf-is-in-use - (message "Making completion list...%s" "done") - ))))))))) + (message "Making completion list...%s" "done")))))))))) (defun gimp-complete-oblist (&optional discard) "Function that always just uses the oblist to complete the symbol at point. @@ -2809,8 +2777,8 @@ If GIMP is not running as an inferior process, open image(s) with gimp-remote." (progn (mapc 'open (mapcar 'expand-file-name img)) (message "Asked GIMP to open multiple images ")) - (open (expand-file-name img)) - (message "Asked GIMP to open %s " img))))) + (message "Asked GIMP to open %s " img) + (open (expand-file-name img)))))) ;; Client Mode ;; Client mode global vars