;;; gimp-shell.el --- shell for Gimp Script Fu Server. ;; Copyright (C) 2000, 2001, 2002, 2003 Olaf Sylvester ;; ;; Author: Olaf Sylvester ;; Web site: http://www.geekware.de/software/emacs ;; Keywords: extensions ;; This program 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 program 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., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;; For upgrading see web site: http://home.netsurf.de/olaf.sylvester/emacs ;; or watch news group gnu.emacs.sources ;;; Commentary: ;; Version: 0.1 ;; ;; Install: ;; 0. Start GIMP and Script-FU Server ;; 1. Load gimp-shell.el ;; 2. Start Gimp-Shell with interactive command gimp-shell ;; ;; Features: ;; - Command History with M-p and M-n ;; - GIMP-Function description by interactive command gimp-describe-function ;; (use SPACE for completion) ;; - load current scheme file by interactive command gimp-load-current-file ;; - load any scheme file by interactive command gimp-load-file ;;; History: ;; ;;; Code: (require 'cmuscheme) (defvar gimp-user-prompt "You> " "Prompt of user.") (defvar gimp-gimp-prompt "Gimp> " "Prompt of Gimp process.") (defvar gimp-process nil) (defvar gimp-process-string "") ;;(setq gimp-process-string "") (defvar gimp-result-handler 'gimp-handler-insert "Handler to handle results comming from script-fu server.") (defvar gimp-mode-map nil) (defvar gimp-users-input-history-index 0) (defvar gimp-users-input-history '()) (defvar gimp-interactive-buffer-name "*gimp*") (defvar gimp-info-buffer-name "*gimp-info*") (defvar gimp-db-cache ()) (defvar gimp-db-cache-for-completing ()) (defun gimp-shell () "Switch to gimp-shell buffer." (interactive) (if (and gimp-process (eq 'open (process-status gimp-process))) (switch-to-buffer gimp-interactive-buffer-name) (call-interactively 'gimp-start-client))) (defun gimp-start-client (host port) (interactive (list (read-from-minibuffer "Host: " "localhost") (read-from-minibuffer "Port: " "10008") )) (if (string= host "") (setq host "localhost")) (if (string= port "") (setq port 10008) (setq port (string-to-int port)));; (condition-case error-data (setq gimp-process (open-network-stream "gimp" gimp-interactive-buffer-name host port)) (error (progn (error "Gimp server running ... no ??? Cannot start gimp client because of %S" error-data) ))) (set-process-filter gimp-process 'gimp-filter) (switch-to-buffer gimp-interactive-buffer-name) (gimp-mode) (goto-char (point-max)) (insert-string gimp-user-prompt) (setq gimp-process-string "") (gimp-startup) ) (defun gimp-startup () "Startup commands" (gimp-send-string "(define (int--emacs-tostring item) (cond ((number? item) (number->string item 10)) ((string? item) (print-to-string item (string-append (substring item 0) \" \" ))) ((null? item) \"()\") ((eq? t item) \"t\") ((pair? item) (string-append \"(\" (unbreakupstr (map int--emacs-tostring item) \" \") \")\")) (TRUE item)))") (gimp-cache-functions) (gimp-send-string "\"Script-fu is running ...\"") ) ;;(gimp-startup) (defun gimp-result-complete (string) (and (>= (length string) 4) (let* ((magik-char (aref string 0)) (error-p (not (eq 0 (aref string 1)))) (high (aref string 2)) (low (aref string 3)) (len (+ 4 low (* 256 high)))) (if (not (eq magik-char ?G)) (message "No MAGIK in %S" string)) ;;(message "%S of %S. Missing: %S" (length string) len ;; (- len (length string))) (if (>= (length string) len) (list (subseq string 4 len) (subseq string len) error-p))))) (defun gimp-filter (proc str) (if (fboundp 'string-make-unibyte) (setq str (string-make-unibyte str))) ;;(message "Got: %s" str) (setq gimp-process-string (concat gimp-process-string str)) (let ((ok nil)) (while (setq ok (gimp-result-complete gimp-process-string)) (condition-case err (apply gimp-result-handler proc ok) (error (progn (message "gimp result eval error: %S" err)))) (setq gimp-process-string (nth 1 ok)) ;;(setq gimp-process-string "") ))) (defun gimp-cache-functions () (interactive) (gimp-call-with-callback "(gimp-procedural-db-query \"\" \"\" \"\" \"\" \"\" \"\" \"\")" 'gimp-set-cache-functions)) (defun gimp-call-with-callback (gimp-call emacs-callback-function) (gimp-send-string (format "(int--emacs-tostring (list \"EMACS-CALL %s\" %s))" emacs-callback-function gimp-call))) (defun gimp-set-cache-functions (list) (setq gimp-db-cache (car (cdr list))) (setq gimp-db-cache-for-completing (mapcar (function list) gimp-db-cache))) (defun gimp-handler-insert (proc result-string rest-string error-p) (if (string-match "(\"EMACS-CALL \\([^\"]+\\)\"" result-string) (let ((fun (car (read-from-string (match-string 1 result-string))))) ;;(y-or-n-p (format "%S" fun)) ;;(message "Special function %s" fun) ;;(message (substring result-string (+ 2 (match-end 1)))) ;;(message (gimp-string-sub (substring result-string (+ 2 (match-end 1))) ;; "\"" "\\\"")) (funcall fun (car (read-from-string (substring result-string (+ 2 (match-end 1))))))) (save-excursion (set-buffer gimp-interactive-buffer-name) (goto-char (process-mark proc)) (insert-string gimp-gimp-prompt result-string) (insert-string "\n") (set-marker (process-mark proc) (point))))) (defun gimp-send-string (string) (let* ((pre "G") (len (length string)) (high (/ len 256)) (low (mod len 256))) (if (> len 65535) (error "GIMP send-string: String to long: %d" len)) (if (> low 1110) ;; arghh Problems with multibyte and send string. Assert low length of 0 (setq string (concat string (make-string (- 256 low) ? )) low 0 high (1+ high))) (setq pre (concat pre (char-to-string high) (char-to-string low))) (message "to GIMP: %d %d %S %S %s" low high pre (string-make-unibyte pre) string) (if (fboundp 'string-as-unibyte) (setq pre (string-as-unibyte pre))) ;(string-as-unibyte "o") (send-string gimp-process pre) (send-string gimp-process string))) (defun gimp-send-region (start ende) (interactive "r") (gimp-send-string (format "(int--emacs-tostring %s)" (buffer-substring start ende)))) (setq gimp-mode-map (make-sparse-keymap)) (define-key gimp-mode-map [return] 'gimp-newline) (define-key gimp-mode-map (read-kbd-macro "M-p") 'gimp-previous-command) (define-key gimp-mode-map (read-kbd-macro "M-n") 'gimp-next-command) (defun gimp-previous-command (n) (interactive "p") (gimp--previous-next-command n)) (defun gimp-next-command (n) (interactive "p") (gimp--previous-next-command (* -1 n))) (defun gimp--previous-next-command (offset) (unless (memq last-command '(gimp-previous-command gimp-next-command)) (setq gimp-users-input-history-index -1)) (gimp-add-current-history-index offset) (when gimp-users-input-history (apply 'delete-region (gimp-region-to-send)) (insert (nth gimp-users-input-history-index gimp-users-input-history)))) (defun gimp-add-current-history-index (offset) (setq gimp-users-input-history-index (+ offset gimp-users-input-history-index)) (if (< gimp-users-input-history-index 0) (setq gimp-users-input-history-index (1- (length gimp-users-input-history))) (if (<= (length gimp-users-input-history) gimp-users-input-history-index) (setq gimp-users-input-history-index 0)))) (defun gimp-string-sub (str from to) "return a string with any matches for the regexp, `from', replaced by `to'." (save-match-data (prog1 (if (string-match from str) (concat (substring str 0 (match-beginning 0)) to (gimp-string-sub (substring str (match-end 0)) from to)) str)))) (defun gimp-mode () (interactive) (kill-all-local-variables) (setq major-mode 'gimp-mode) (setq mode-name "Gimp") (use-local-map gimp-mode-map) (make-local-variable 'kill-buffer-hook) ;;(add-hook 'kill-buffer-hook 'gimp-say-goodbye) (set-marker (process-mark (get-buffer-process (current-buffer))) (point-max))) (defun gimp-newline () (interactive) ;;(if (not (string= "" gimp-process-string)) ;; (error "Waiting for result ...")) (let ((str (gimp-string-to-send))) (if (> (length str) 0) (progn ;;(y-or-n-p str) (if (or (null gimp-users-input-history) (not (string= (car gimp-users-input-history) str))) (setq gimp-users-input-history (cons str gimp-users-input-history))) (gimp-send-string (concat "(int--emacs-tostring " str ")")))) (newline) (set-marker (process-mark (get-buffer-process (current-buffer))) (point-max)) (insert-string gimp-user-prompt))) (defun gimp-string-to-send () "Return users input for script-fu evaluation." (apply 'buffer-substring (gimp-region-to-send))) (defun gimp-region-to-send () "Return region for script-fu evaluation." (save-excursion (goto-char (process-mark gimp-process)) (search-forward-regexp gimp-user-prompt nil t) (list (point) (point-max)))) (defun gimp-load-file (filename) (interactive "fFile: ") (gimp-send-string (concat "(load \"" filename "\")"))) (defun gimp-load-current-file () (interactive) (gimp-load-file (buffer-file-name))) (defun gimp-append-to-info (&rest strings) (save-excursion (while strings (let ((string (car strings))) (set-buffer gimp-info-buffer-name) (goto-char (point-max)) (cond ((listp string) (mapcar (lambda (x) (insert-string (format "%s\n" x))) string)) (t (insert (format "%s" string))))) (setq strings (cdr strings))))) (defun gimp-pop-to-info (string) (pop-to-buffer gimp-info-buffer-name) (save-excursion (set-buffer gimp-info-buffer-name) (erase-buffer) (gimp-append-to-info string))) (defun gimp-info-function (tupel &optional append-p) "Callback function to create a description for a Gimp-PD-function." (let ((fun (car tupel)) (description (cadr tupel))) (if append-p (gimp-append-to-info (format "Name : %s\n" fun)) (gimp-pop-to-info (format "Name : %s\n" fun))) (gimp-append-to-info "Blurb : " (car description) "\n") (gimp-append-to-info "Help : " (nth 1 description) "\n") (gimp-append-to-info "Author: " (nth 2 description) "\n") (gimp-append-to-info "(C) : " (nth 3 description) "\n") (gimp-append-to-info "Date : " (nth 4 description) "\n") (gimp-append-to-info "\n") ;(gimp-append-to-info description "\n") ;(message "%S" description) (dotimes (i (nth 6 description)) (gimp-call-with-callback (format "(gimp-procedural-db-proc-arg \"%s\" %d)" fun i) "gimp-info-arg")) (dotimes (i (nth 7 description)) (gimp-call-with-callback (format "(gimp-procedural-db-proc-val \"%s\" %d)" fun i) "gimp-info-result")) )) (defun gimp-show-infos-to-function (pdb-function) (interactive "sName: ") (gimp-call-with-callback (format "(list \"%s\" (gimp-procedural-db-proc-info \"%s\"))" pdb-function pdb-function) "gimp-info-function")) (defvar gimp-type-to-readable-type-map '((0 . "INT32") (1 . "INT16") (2 . "INT8") (3 . "FLOAT") (4 . "STRING") (5 . "INT32ARRAY") (6 . "INT16ARRAY") (7 . "INT8ARRAY") (8 . "FLOATARRAY") (9 . "STRINGARRAY") (10 . "COLOR") (11 . "REGION") (12 . "DISPLAY") (13 . "IMAGE") (14 . "LAYER") (15 . "CHANNEL") (16 . "DRAWABLE") (17 . "SELECTION") (18 . "BOUNDARY") (19 . "PATH") (20 . "STATUS"))) (defun gimp-type-to-readable-type (type) (or (cdr (assoc type gimp-type-to-readable-type-map)) "UNKNOWN")) (defun gimp-info-arg (liste) (gimp-append-to-info (format "Arg : %-10s %-10s %s\n" (car (cdr liste)) (gimp-type-to-readable-type (car liste)) (car (cdr (cdr liste))) (length liste)))) (defun gimp-info-result (liste) (gimp-append-to-info (format "Result: %-10s %-10s %s\n" (car (cdr liste)) (gimp-type-to-readable-type (car liste)) (car (cdr (cdr liste))) (length liste)))) (defun gimp-describe-function (function) "Display the full documentation of Gimp FUNCTION (a symbol)." (interactive (let ((fn (function-called-at-point)) (enable-recursive-minibuffers t) val) (setq val (completing-read (if fn (format "Describe gimp function (default %s): " fn) "Describe gimp function: ") gimp-db-cache-for-completing nil nil nil nil (symbol-name fn))) (list (if (equal val "") fn (intern val))))) (gimp-show-infos-to-function function)) ;;; Scheme mode modifications (defun scheme-send-region (start end) "Send the current region to the inferior Scheme process." (interactive "r") (gimp-send-region start end)) (defun scheme-compile-region (start end) "Compile the current region in the inferior Scheme process. \(A BEGIN is wrapped around the region: (BEGIN ))" (interactive "r") (error "Not implemented yet")) (defun scheme-load-file (file-name) "Load a Scheme file into the inferior Scheme process." (interactive (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file scheme-source-modes t)) ; T because LOAD ; needs an exact name (error "Not implemented yet")) ;; (gimp-start-client) ;; ;; (gimp-send-string "(int--emacs-tostring (+ 2 3 4))") ;; (gimp-send-string "") (provide 'gimp) ;;; gimp-shell.el ends here