From 9b4016cd9bce8354ac3eede20345e83db8c65b94 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sat, 7 Feb 2009 16:08:42 +0100 Subject: Elisp utilities (mostly imported from FUEL). --- elisp/geiser-base.el | 99 +++++++++++++++++++++++++++++++++++++++++++++++++++ elisp/geiser-log.el | 96 +++++++++++++++++++++++++++++++++++++++++++++++++ elisp/geiser-popup.el | 88 +++++++++++++++++++++++++++++++++++++++++++++ elisp/geiser-repl.el | 40 +++++++++++++++++++++ 4 files changed, 323 insertions(+) create mode 100644 elisp/geiser-base.el create mode 100644 elisp/geiser-log.el create mode 100644 elisp/geiser-popup.el create mode 100644 elisp/geiser-repl.el (limited to 'elisp') diff --git a/elisp/geiser-base.el b/elisp/geiser-base.el new file mode 100644 index 0000000..4634a29 --- /dev/null +++ b/elisp/geiser-base.el @@ -0,0 +1,99 @@ +;;; geiser-base.el --- shared bits + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, tools + +;; 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 3 of the License, 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 this program. If not, see . + +;;; Commentary: + +;; Settings and vars shared by all geiser modules, including little +;; utilities and emacsen compatibility bits. + +;;; Code: + + +;;; Versioning: + +(defconst geiser-version-major 0 + "Geiser's major version number.") +(defconst geiser-version-minor 1 + "Geiser's minor version number.") + +(defun geiser-version-string () + "Geiser's version as a string." + (format "%s.%s" geiser-version-major geiser-version-minor)) + +(defun geiser-version () + "Echoes Geiser's version." + (interactive) + (message "Geiser %s" (geiser-version-string))) + + +;;; Customization group: + +(defgroup geiser nil + "Geiser framework for Guile-Emacs interaction." + :group 'languages) + + +;;; Emacs compatibility: + +(eval-after-load "ring" + '(when (not (fboundp 'ring-member)) + (defun ring-member (ring item) + (catch 'found + (dotimes (ind (ring-length ring) nil) + (when (equal item (ring-ref ring ind)) + (throw 'found ind))))))) + +(when (not (fboundp 'completion-table-dynamic)) + (defun completion-table-dynamic (fun) + (lexical-let ((fun fun)) + (lambda (string pred action) + (with-current-buffer (let ((win (minibuffer-selected-window))) + (if (window-live-p win) (window-buffer win) + (current-buffer))) + (complete-with-action action (funcall fun string) string pred)))))) + +(when (not (fboundp 'looking-at-p)) + (defsubst looking-at-p (regexp) + (let ((inhibit-changing-match-data t)) + (looking-at regexp)))) + + +;;; Utilities: + +(defun geiser--shorten-str (str len &optional sep) + (let ((str-len (length str))) + (if (<= str-len len) + str + (let* ((sep (or sep " ... ")) + (sep-len (length sep)) + (prefix-len (/ (- str-len sep-len) 2)) + (prefix (substring str 0 prefix-len)) + (suffix (substring str (- str-len prefix-len)))) + (format "%s%s%s" prefix sep suffix))))) + +(defun geiser--region-to-string (begin &optional end) + (let ((end (or end (point)))) + (when (< begin end) + (let* ((str (buffer-substring-no-properties begin end)) + (pieces (split-string str nil t))) + (mapconcat 'identity pieces " "))))) + +(provide 'geiser-base) +;;; geiser-base.el ends here diff --git a/elisp/geiser-log.el b/elisp/geiser-log.el new file mode 100644 index 0000000..68e0fae --- /dev/null +++ b/elisp/geiser-log.el @@ -0,0 +1,96 @@ +;; geiser-log.el -- logging utilities + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Start date: Sat Feb 07, 2009 12:07 + +;; 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 3 of the License, 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 this program. If not, see . + +;;; Comentary: + +;; Some utilities for maintaining a simple log buffer, mainly for +;; debugging purposes. + +;;; Code: + +(require 'geiser-popup) +(require 'geiser-base) + + +;;; Customization: + +(defvar geiser-log--buffer-name "*geiser messages*" + "Name of the Geiser log buffer.") + +(defvar geiser-log--max-buffer-size 32000 + "Maximum size of the Geiser messages log.") + +(defvar geiser-log--max-message-size 512 + "Maximum size of individual Geiser log messages.") + +(defvar geiser-log--verbose-p t + "Log level for Geiser messages") + +(defvar geiser-log--inhibit-p nil + "Set this to t to inhibit all log messages") + + +;;; Log buffer and mode: + +(define-derived-mode geiser-messages-mode fundamental-mode "Geiser Messages" + "Simple mode for Geiser log messages buffer." + (kill-all-local-variables) + (buffer-disable-undo) + (set (make-local-variable 'comint-redirect-subvert-readonly) t) + (add-hook 'after-change-functions + '(lambda (b e len) + (let ((inhibit-read-only t)) + (when (> b geiser-log--max-buffer-size) + (delete-region (point-min) b)))) + nil t) + (setq buffer-read-only t)) + +(geiser-popup--define log geiser-log--buffer-name geiser-messages-mode) + + +;;; Logging functions: + +(defun geiser-log--msg (type &rest args) + (unless geiser-log--inhibit-p + (geiser-log--with-buffer + (insert (geiser--shorten-str (format "\n%s: %s\n" type (apply 'format args)) + geiser-log--max-message-size))))) + +(defsubst geiser-log--warn (&rest args) + (apply 'geiser-log--msg 'WARNING args)) + +(defsubst geiser-log--error (&rest args) + (apply 'geiser-log--msg 'ERROR args)) + +(defsubst geiser-log--info (&rest args) + (when geiser-log--verbose-p + (apply 'geiser-log--msg 'INFO args) "")) + + +;;; User commands: + +(defun geiser-show-logs () + "Show Geiser log messages." + (interactive) + (geiser-log--pop-to-buffer)) + + +(provide 'geiser-log) +;;; geiser-log.el ends here diff --git a/elisp/geiser-popup.el b/elisp/geiser-popup.el new file mode 100644 index 0000000..d412029 --- /dev/null +++ b/elisp/geiser-popup.el @@ -0,0 +1,88 @@ +;; geiser-popup.el -- popup windows + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Start date: Sat Feb 07, 2009 14:05 + +;; 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 3 of the License, 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 this program. If not, see . + +;;; Comentary: + +;; Utilities for defining pop-up windows that get easily out of the +;; way. + +;;; Code: + +(make-variable-buffer-local + (defvar geiser-popup--created-window nil)) + +(make-variable-buffer-local + (defvar geiser-popup--selected-window nil)) + +(defun geiser-popup--display (&optional buffer) + (when buffer (set-buffer buffer)) + (let ((selected-window (selected-window)) + (buffer (current-buffer))) + (unless (eq selected-window (get-buffer-window buffer)) + (let ((windows)) + (walk-windows (lambda (w) (push w windows)) nil t) + (prog1 (pop-to-buffer buffer) + (set (make-local-variable 'geiser-popup--created-window) + (unless (memq (selected-window) windows) (selected-window))) + (set (make-local-variable 'geiser-popup--selected-window) + selected-window)))))) + +(defun geiser-popup--quit () + (interactive) + (let ((selected geiser-popup--selected-window) + (created geiser-popup--created-window)) + (bury-buffer) + (when (eq created (selected-window)) (delete-window created)) + (when (window-live-p selected) (select-window selected)))) + +(define-minor-mode geiser-popup-mode + "Mode for displaying read only stuff" + nil nil + '(("q" . geiser-popup--quit)) + (setq buffer-read-only t)) + +(defmacro geiser-popup--define (base name mode) + (let ((get-buff (intern (format "geiser-%s--buffer" base))) + (pop-buff (intern (format "geiser-%s--pop-to-buffer" base))) + (with-macro (intern (format "geiser-%s--with-buffer" base))) + (method (make-symbol "method"))) + `(progn + (defun ,get-buff () + (or (get-buffer ,name) + (with-current-buffer (get-buffer-create ,name) + (,mode) + (geiser-popup-mode) + (current-buffer)))) + (defun ,pop-buff (&optional ,method) + (cond ((eq ,method 'buffer) (switch-to-buffer (,get-buff))) + ((eq ,method 'frame) (switch-to-buffer-other-frame (,get-buff))) + (t (geiser-popup--display (,get-buff))))) + (defmacro ,with-macro (&rest body) + (let ((buff ',get-buff)) + `(with-current-buffer (funcall ',buff) + (let ((inhibit-read-only t)) + ,@body)))) + (put ',with-macro 'lisp-indent-function 'defun)))) + +(put 'geiser-popup--define 'lisp-indent-function 1) + + +(provide 'geiser-popup) +;;; geiser-popup.el ends here diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el new file mode 100644 index 0000000..3c75cfc --- /dev/null +++ b/elisp/geiser-repl.el @@ -0,0 +1,40 @@ +;;; geiser-repl.el --- Geiser's Guile REPL + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, tools + +;; 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 3 of the License, 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 this program. If not, see . + +;;; Commentary: + +;; Major mode (comint-based) to interact with an inferior Guile +;; process using Geiser's modules. + +;;; Code: + +(require 'geiser-base) +(require 'comint) + + +;;; Customization: + + +;;; geiser-repl mode: + + + +(provide 'geiser-repl) +;;; geiser-repl.el ends here -- cgit v1.2.3