summaryrefslogtreecommitdiff
path: root/emacs
diff options
context:
space:
mode:
authorcvs2svn <admin@example.com>2002-08-04 00:18:34 +0000
committercvs2svn <admin@example.com>2002-08-04 00:18:34 +0000
commit2f4c89c4f475d3b2c718cbd4332c650214488ff9 (patch)
tree5abd57b1ace53b0c6970da9395f15d80d5f79430 /emacs
parentc7743d027a335eae585335b959e483c5a6c38d36 (diff)
downloadguile-after-hanwen-gc-change.tar.gz
This commit was manufactured by cvs2svn to create tagafter-hanwen-gc-change
'after-hanwen-gc-change'.
Diffstat (limited to 'emacs')
-rw-r--r--emacs/ChangeLog89
-rw-r--r--emacs/README13
-rw-r--r--emacs/gud-guile.el81
-rw-r--r--emacs/guile-c.el178
-rw-r--r--emacs/guile-emacs.scm154
-rw-r--r--emacs/guile-scheme.el346
-rw-r--r--emacs/guile.el215
-rw-r--r--emacs/multistring.el222
-rw-r--r--emacs/patch.el106
-rw-r--r--emacs/ppexpand.el94
-rw-r--r--emacs/update-changelog.el145
11 files changed, 0 insertions, 1643 deletions
diff --git a/emacs/ChangeLog b/emacs/ChangeLog
deleted file mode 100644
index 5189f107f..000000000
--- a/emacs/ChangeLog
+++ /dev/null
@@ -1,89 +0,0 @@
-2001-11-19 Thien-Thi Nguyen <ttn@giblet.glug.org>
-
- * README: Use less forking for indexing command.
- Update index.
-
- * gud-guile.el: New file.
-
- * update-changelog.el:
- When run as a batch program, invoke `(ucl-update "ChangeLog")'
- instead of `(ucl-update-all)'.
-
- (ucl-outdir): Delete this var.
- (ucl-update): Arg now specifies change log file
- instead of cvs module directory.
- Make interactive.
- (ucl-update-all): Delete this func.
-
- * update-changelog.el: New file.
-
- * patch.el (patch-send):
- Renamed from `patch-submit'.
- Gadzooks what kind of world is this?
-
-2001-10-25 Thien-Thi Nguyen <ttn@giblet.glug.org>
-
- * README, patch.el:
- New file.
-
-2001-10-25 Thien-Thi Nguyen <ttn@glug.org>
-
- * patch.el, README: New files.
-
-2001-06-21 Neil Jerram <neil@ossau.uklinux.net>
-
- * guile.el (guile-channel-file): Signal an error if unable to find
- channel.scm.
- Change "gulie" typos to "guile".
-
-2001-05-06 Keisuke Nishida <kxn30@po.cwru.edu>
-
- * guile.el (guile:eval): Propagate user interrupt.
- (keywordp): Define it if not defined yet.
- (guile-use-module): New macro.
- (guile-process-import-module): Renamed from guile-process-use-module.
-
- * guile-emacs.scm (guile-emacs-apropos, guile-emacs-describe):
- New procedures.
-
- * guile-scheme.el (guile-scheme-mode-map): Use
- `shared-lisp-mode-map' as the parent keymap if
- `lisp-mode-shared-map' is not defined.
- (guile-scheme-module): New variable.
- (guile-scheme-set-module): Set module only when necessary.
- (guile-scheme-eval-print-last-sexp): Insert newline after eval.
- (guile-scheme-complete-table): New variable.
- (guile-scheme-input-symbol): New function.
- (guile-scheme-apropos, guile-scheme-describe,
- guile-scheme-kill-process): New commands.
-
-2001-04-25 Keisuke Nishida <kxn30@po.cwru.edu>
-
- * guile.el, guile-scheme.el, guile-emacs.scm: New files.
-
-2001-03-13 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
-
- * guile-c.el (guile-c-edit-docstring): Set fill-column to 63, so
- that fill-paragraph'ed docstrings fit nicely when indented.
-
-2001-03-13 Keisuke Nishida <kxn30@po.cwru.edu>
-
- * guile-c.el (guile-c-window-configuration): New variable.
- (guile-c-edit-docstring, guile-c-edit-finish):
- Save/restore window-configuration.
-
-2001-03-12 Keisuke Nishida <kxn30@po.cwru.edu>
-
- * guile-c.el (guile-c-deprecate-region): New command.
-
-2001-03-11 Keisuke Nishida <kxn30@po.cwru.edu>
-
- * guile-c.el: New file.
-
-2000-05-28 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
-
- * ppexpand.el: New file.
-
-2000-01-18 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
-
- * multistring.el: New file.
diff --git a/emacs/README b/emacs/README
deleted file mode 100644
index 73e021581..000000000
--- a/emacs/README
+++ /dev/null
@@ -1,13 +0,0 @@
-Index
-
-gud-guile.el --- Support for debugging guile internals
-guile-c.el --- Guile C editing commands
-guile-scheme.el --- Guile Scheme editing mode
-guile.el --- Emacs Guile interface
-multistring.el --- editing multiline strings.
-patch.el --- mail/apply a patch
-ppexpand.el --- temporarily expanding macros in a pretty way.
-update-changelog.el --- stitch rcs2log output to ChangeLog
-
-
-Generated using: for f in *.el ; do sed -e 's/^....//g' -e '1q' $f ; done
diff --git a/emacs/gud-guile.el b/emacs/gud-guile.el
deleted file mode 100644
index a0a70fabe..000000000
--- a/emacs/gud-guile.el
+++ /dev/null
@@ -1,81 +0,0 @@
-;;; gud-guile.el --- Support for debugging guile internals
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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.
-
-;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
-;;; Version: 1
-;;; Favorite-Favorite: Favorite-Favorite
-
-;;; Commentary:
-
-;; This is a grab bag of stuff for doing "gdb guile" in Emacs.
-;; The var `gdb-guile-suggested-gdbinit' has a string that is
-;; snarfed from ../HACKING. (todo: Write `gdb-guile-init' to
-;; send it to gdb...)
-
-;;; Code:
-
-(require 'cl)
-
-(defun gdb-guile-display-scm ()
- (interactive)
- (save-excursion
- (let ((sym (thing-at-point 'symbol))
- (proc (get-buffer-process
- (find-if (lambda (buf)
- (string-match "^.gud-." (buffer-name buf)))
- (buffer-list)))))
- (mapc (lambda (template)
- (process-send-string proc (format template sym)))
- (list
- "set gdb_print(%s)\n"
- "printf \"%s: %%s\\n\", gdb_output\n")))))
-
-(defvar gdb-guile-suggested-gdbinit "
-define gp
-set gdb_print($arg0)
-print gdb_output
-end
-document gp
-Executes (object->string arg)
-end
-
-define ge
-call gdb_read($arg0)
-call gdb_eval(gdb_result)
-set gdb_print(gdb_result)
-print gdb_output
-end
-document ge
-Executes (print (eval (read arg))): ge \"(+ 1 2)\" => 3
-end
-
-define gh
-call g_help(scm_str2symbol($arg0), 20)
-set gdb_print($1)
-print gdb_output
-end
-document gh
-Prints help string for arg: gh \"enved-target\"
-end
-"
- "A useful .gdbinit")
-
-(provide 'gud-guile)
-
-;;; gud-guile.el ends here
diff --git a/emacs/guile-c.el b/emacs/guile-c.el
deleted file mode 100644
index fe05159ec..000000000
--- a/emacs/guile-c.el
+++ /dev/null
@@ -1,178 +0,0 @@
-;;; guile-c.el --- Guile C editing commands
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; 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 this program; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; (add-hook 'c-mode-hook
-;; (lambda ()
-;; (require 'guile-c)
-;; (define-key c-mode-map "\C-c\C-g\C-p" 'guile-c-insert-define)
-;; (define-key c-mode-map "\C-c\C-g\C-e" 'guile-c-edit-docstring)
-;; (define-key c-mode-map "\C-c\C-g\C-d" 'guile-c-deprecate-region)
-;; ))
-
-;;; Code:
-
-(require 'cc-mode)
-
-(defvar guile-c-prefix "scm_")
-
-
-;;;
-;;; Insert templates
-;;;
-
-(defun guile-c-insert-define ()
- "Insert a template of a Scheme procedure.
-
- M-x guile-c-insert-define RET foo arg , opt . rest =>
-
- SCM_DEFINE (scm_foo, \"foo\", 1, 1, 1,
- (SCM arg, SCM opt, SCM rest),
- \"\")
- #define FUNC_NAME s_scm_foo
- {
-
- }
- #undef FUNC_NAME"
- (interactive)
- (let ((tokens (split-string (read-string "Procedure: ")))
- name args opts rest)
- ;; Get procedure name
- (if (not tokens) (error "No procedure name"))
- (setq name (car tokens) tokens (cdr tokens))
- ;; Get requisite arguments
- (while (and tokens (not (member (car tokens) '("," "."))))
- (setq args (cons (car tokens) args) tokens (cdr tokens)))
- (setq args (nreverse args))
- ;; Get optional arguments
- (when (string= (car tokens) ",")
- (setq tokens (cdr tokens))
- (while (and tokens (not (string= (car tokens) ".")))
- (setq opts (cons (car tokens) opts) tokens (cdr tokens)))
- (setq opts (nreverse opts)))
- ;; Get rest argument
- (when (string= (car tokens) ".")
- (setq rest (list (cadr tokens))))
- ;; Insert template
- (let ((c-name (guile-c-name-from-scheme-name name)))
- (insert (format "SCM_DEFINE (%s, \"%s\", %d, %d, %d,\n"
- c-name name (length args) (length opts) (length rest))
- "\t ("
- (mapconcat (lambda (a) (concat "SCM " a))
- (append args opts rest) ", ")
- "),\n"
- "\t \"\")\n"
- "#define FUNC_NAME s_" c-name "\n"
- "{\n\n}\n"
- "#undef FUNC_NAME\n\n")
- (previous-line 4)
- (indent-for-tab-command))))
-
-(defun guile-c-name-from-scheme-name (name)
- (while (string-match "\\?$" name) (setq name (replace-match "_p" t t name)))
- (while (string-match "!$" name) (setq name (replace-match "_x" t t name)))
- (while (string-match "^%" name) (setq name (replace-match "sys_" t t name)))
- (while (string-match "->" name) (setq name (replace-match "_to_" t t name)))
- (while (string-match "[-:]" name) (setq name (replace-match "_" t t name)))
- (concat guile-c-prefix name))
-
-
-;;;
-;;; Edit docstrings
-;;;
-
-(defvar guile-c-window-configuration nil)
-
-(defun guile-c-edit-docstring ()
- (interactive)
- (let* ((region (guile-c-find-docstring))
- (doc (if region (buffer-substring (car region) (cdr region)))))
- (if (not doc)
- (error "No docstring!")
- (setq guile-c-window-configuration (current-window-configuration))
- (with-current-buffer (get-buffer-create "*Guile Docstring*")
- (erase-buffer)
- (insert doc)
- (goto-char (point-min))
- (while (not (eobp))
- (if (looking-at "[ \t]*\"")
- (delete-region (match-beginning 0) (match-end 0)))
- (end-of-line)
- (if (eq (char-before (point)) ?\")
- (delete-backward-char 1))
- (if (and (eq (char-before (point)) ?n)
- (eq (char-before (1- (point))) ?\\))
- (delete-backward-char 2))
- (forward-line))
- (goto-char (point-min))
- (texinfo-mode)
- (if global-font-lock-mode
- (font-lock-fontify-buffer))
- (local-set-key "\C-c\C-c" 'guile-c-edit-finish)
- (setq fill-column 63)
- (switch-to-buffer-other-window (current-buffer))
- (message "Type `C-c C-c' to finish")))))
-
-(defun guile-c-edit-finish ()
- (interactive)
- (goto-char (point-max))
- (while (eq (char-before) ?\n) (backward-delete-char 1))
- (goto-char (point-min))
- (if (eobp)
- (insert "\"\"")
- (while (not (eobp))
- (insert "\t \"")
- (end-of-line)
- (insert (if (eobp) "\"" "\\n\""))
- (forward-line 1)))
- (let ((doc (buffer-string)))
- (kill-buffer (current-buffer))
- (set-window-configuration guile-c-window-configuration)
- (let ((region (guile-c-find-docstring)))
- (goto-char (car region))
- (delete-region (car region) (cdr region)))
- (insert doc)))
-
-(defun guile-c-find-docstring ()
- (save-excursion
- (if (re-search-backward "^SCM_DEFINE" nil t)
- (let ((start (progn (forward-line 2) (point))))
- (while (looking-at "[ \t]*\"")
- (forward-line 1))
- (cons start (- (point) 2))))))
-
-
-;;;
-;;; Others
-;;;
-
-(defun guile-c-deprecate-region (start end)
- (interactive "r")
- (save-excursion
- (let ((marker (make-marker)))
- (set-marker marker end)
- (goto-char start)
- (insert "#if (SCM_DEBUG_DEPRECATED == 0)\n\n")
- (goto-char marker)
- (insert "\n#endif /* (SCM_DEBUG_DEPRECATED == 0) */\n"))))
-
-(provide 'guile-c)
-
-;; guile-c.el ends here
diff --git a/emacs/guile-emacs.scm b/emacs/guile-emacs.scm
deleted file mode 100644
index 78b897e31..000000000
--- a/emacs/guile-emacs.scm
+++ /dev/null
@@ -1,154 +0,0 @@
-;;; guile-emacs.scm --- Guile Emacs interface
-
-;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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.
-
-;;; Code:
-
-(use-modules (ice-9 regex))
-(use-modules (ice-9 channel))
-(use-modules (ice-9 session))
-(use-modules (ice-9 documentation))
-
-
-;;;
-;;; Emacs Lisp channel
-;;;
-
-(define (emacs-lisp-channel)
-
- (define (native-type? x)
- (or (integer? x) (symbol? x) (string? x) (pair? x) (vector? x)))
-
- (define (emacs-lisp-print ch val)
- (cond
- ((unspecified? val))
- ((eq? val #t) (channel-print-value ch 't))
- ((or (eq? val #f) (null? val)) (channel-print-value ch 'nil))
- ((native-type? val) (channel-print-value ch val))
- (else (channel-print-token ch val))))
-
- (channel-open (make-object-channel emacs-lisp-print)))
-
-
-;;;
-;;; Scheme channel
-;;;
-
-(define (emacs-scheme-channel)
- (define (print ch val) (channel-print-value ch (object->string val)))
- (channel-open (make-object-channel print)))
-
-
-;;;
-;;; for guile-import and guile-import-module
-;;;
-
-(define (guile-emacs-export-procedure name proc docs)
- (define (procedure-arity proc)
- (assq-ref (procedure-properties proc) 'arity))
-
- (define (procedure-args proc)
- (let ((source (procedure-source proc)))
- (if source
- ;; formals -> emacs args
- (let loop ((formals (cadr source)))
- (cond
- ((null? formals) '())
- ((symbol? formals) `(&rest ,formals))
- (else (cons (car formals) (loop (cdr formals))))))
- ;; arity -> emacs args
- (let* ((arity (procedure-arity proc))
- (nreqs (car arity))
- (nopts (cadr arity))
- (restp (caddr arity)))
- (define (nsyms n)
- (if (= n 0) '() (cons (gensym "a") (nsyms (1- n)))))
- (append! (nsyms nreqs)
- (if (> nopts 0) (cons '&optional (nsyms nopts)) '())
- (if restp (cons '&rest (nsyms 1)) '()))))))
-
- (define (procedure-call name args)
- (let ((restp (memq '&rest args))
- (args (delq '&rest (delq '&optional args))))
- (if restp
- `('apply ',name ,@args)
- `(',name ,@args))))
-
- (let ((args (procedure-args proc))
- (docs (and docs (object-documentation proc))))
- `(defun ,name ,args
- ,@(if docs (list docs) '())
- (guile-lisp-flat-eval ,@(procedure-call (procedure-name proc) args)))))
-
-(define (guile-emacs-export proc-name func-name docs)
- (let ((proc (module-ref (current-module) proc-name)))
- (guile-emacs-export-procedure func-name proc docs)))
-
-(define (guile-emacs-export-procedures module-name docs)
- (define (module-public-procedures name)
- (hash-fold (lambda (s v d)
- (let ((val (variable-ref v)))
- (if (procedure? val) (acons s val d) d)))
- '() (module-obarray (resolve-interface name))))
- `(progn ,@(map (lambda (n+p)
- (guile-emacs-export-procedure (car n+p) (cdr n+p) docs))
- (module-public-procedures module-name))))
-
-
-;;;
-;;; for guile-scheme-complete-symbol
-;;;
-
-(define (guile-emacs-complete-alist str)
- (sort! (apropos-fold (lambda (module name val data)
- (cons (list (symbol->string name)
- (cond ((procedure? val) " <p>")
- ((macro? val) " <m>")
- (else "")))
- data))
- '() (string-append "^" (regexp-quote str))
- apropos-fold-all)
- (lambda (p1 p2) (string<? (car p1) (car p2)))))
-
-
-;;;
-;;; for guile-scheme-apropos
-;;;
-
-(define (guile-emacs-apropos regexp)
- (with-output-to-string (lambda () (apropos regexp))))
-
-
-;;;
-;;; for guile-scheme-describe
-;;;
-
-(define (guile-emacs-describe sym)
- (object-documentation (eval sym (current-module))))
-
-
-;;;
-;;; Guile 1.4 compatibility
-;;;
-
-(define object->string
- (if (defined? 'object->string)
- object->string
- (lambda (x) (format #f "~S" x))))
-
-;;; guile-emacs.scm ends here
diff --git a/emacs/guile-scheme.el b/emacs/guile-scheme.el
deleted file mode 100644
index 10ea10db7..000000000
--- a/emacs/guile-scheme.el
+++ /dev/null
@@ -1,346 +0,0 @@
-;;; guile-scheme.el --- Guile Scheme editing mode
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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.
-
-;;; Commentary:
-
-;; Put the following lines in your ~/.emacs:
-;;
-;; (require 'guile-scheme)
-;; (setq initial-major-mode 'scheme-interaction-mode)
-
-;;; Code:
-
-(require 'guile)
-(require 'scheme)
-
-(defgroup guile-scheme nil
- "Editing Guile-Scheme code"
- :group 'lisp)
-
-(defvar guile-scheme-syntax-keywords
- '((begin 0) (if 1) (cond 0) (case 1) (do 2)
- quote syntax lambda and or else delay receive use-modules
- (match 1) (match-lambda 0) (match-lambda* 0)
- (let scheme-let-indent) (let* 1) (letrec 1) (and-let* 1)
- (let-syntax 1) (letrec-syntax 1) (syntax-rules 1) (syntax-case 2)))
-
-(defvar guile-scheme-special-procedures
- '((catch 1) (lazy-catch 1) (stack-catch 1)
- map for-each (dynamic-wind 3)))
-
-;; set indent functions
-(dolist (x (append guile-scheme-syntax-keywords
- guile-scheme-special-procedures))
- (when (consp x)
- (put (car x) 'scheme-indent-function (cadr x))))
-
-(defconst guile-scheme-font-lock-keywords
- (eval-when-compile
- (list
- (list (concat "(\\(define\\*?\\("
- ;; Function names.
- "\\(\\|-public\\|-method\\|-generic\\)\\|"
- ;; Macro names, as variable names.
- "\\(-syntax\\|-macro\\)\\|"
- ;; Others
- "-\\sw+\\)\\)\\>"
- ;; Any whitespace and declared object.
- "\\s *(?\\(\\sw+\\)?")
- '(1 font-lock-keyword-face)
- '(5 (cond ((match-beginning 3) font-lock-function-name-face)
- ((match-beginning 4) font-lock-variable-name-face)
- (t font-lock-type-face)) nil t))
- (list (concat
- "(" (regexp-opt
- (mapcar (lambda (e)
- (prin1-to-string (if (consp e) (car e) e)))
- (append guile-scheme-syntax-keywords
- guile-scheme-special-procedures)) 'words))
- '(1 font-lock-keyword-face))
- '("<\\sw+>" . font-lock-type-face)
- '("\\<:\\sw+\\>" . font-lock-builtin-face)
- ))
- "Expressions to highlight in Guile Scheme mode.")
-
-
-;;;
-;;; Guile Scheme mode
-;;;
-
-(defvar guile-scheme-mode-map nil
- "Keymap for Guile Scheme mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
-
-(unless guile-scheme-mode-map
- (let ((map (make-sparse-keymap "Guile-Scheme")))
- (setq guile-scheme-mode-map map)
- (cond ((boundp 'lisp-mode-shared-map)
- (set-keymap-parent map lisp-mode-shared-map))
- ((boundp 'shared-lisp-mode-map)
- (set-keymap-parent map shared-lisp-mode-map)))
- (define-key map [menu-bar] (make-sparse-keymap))
- (define-key map [menu-bar guile-scheme] (cons "Guile-Scheme" map))
- (define-key map [uncomment-region]
- '("Uncomment Out Region" . (lambda (beg end)
- (interactive "r")
- (comment-region beg end '(4)))))
- (define-key map [comment-region] '("Comment Out Region" . comment-region))
- (define-key map [indent-region] '("Indent Region" . indent-region))
- (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
- (define-key map "\e\C-i" 'guile-scheme-complete-symbol)
- (define-key map "\e\C-x" 'guile-scheme-eval-define)
- (define-key map "\C-x\C-e" 'guile-scheme-eval-last-sexp)
- (define-key map "\C-c\C-b" 'guile-scheme-eval-buffer)
- (define-key map "\C-c\C-r" 'guile-scheme-eval-region)
- (define-key map "\C-c:" 'guile-scheme-eval-expression)
- (define-key map "\C-c\C-a" 'guile-scheme-apropos)
- (define-key map "\C-c\C-d" 'guile-scheme-describe)
- (define-key map "\C-c\C-k" 'guile-scheme-kill-process)
-
- (put 'comment-region 'menu-enable 'mark-active)
- (put 'uncomment-region 'menu-enable 'mark-active)
- (put 'indent-region 'menu-enable 'mark-active)))
-
-(defcustom guile-scheme-mode-hook nil
- "Normal hook run when entering `guile-scheme-mode'."
- :type 'hook
- :group 'guile-scheme)
-
-;;;###autoload
-(defun guile-scheme-mode ()
- "Major mode for editing Guile Scheme code.
-Editing commands are similar to those of `scheme-mode'.
-
-\\{scheme-mode-map}
-Entry to this mode calls the value of `scheme-mode-hook'
-if that value is non-nil."
- (interactive)
- (kill-all-local-variables)
- (setq mode-name "Guile Scheme")
- (setq major-mode 'guile-scheme-mode)
- (use-local-map guile-scheme-mode-map)
- (scheme-mode-variables)
- (setq mode-line-process
- '(:eval (if (processp guile-scheme-adapter)
- (format " [%s]" guile-scheme-command)
- "")))
- (setq font-lock-defaults
- '((guile-scheme-font-lock-keywords)
- nil t (("+-*/.<>=!?$%_&~^:@" . "w")) beginning-of-defun
- (font-lock-mark-block-function . mark-defun)))
- (run-hooks 'guile-scheme-mode-hook))
-
-
-;;;
-;;; Scheme interaction mode
-;;;
-
-(defvar scheme-interaction-mode-map ()
- "Keymap for Scheme Interaction mode.
-All commands in `guile-scheme-mode-map' are inherited by this map.")
-
-(unless scheme-interaction-mode-map
- (let ((map (make-sparse-keymap)))
- (setq scheme-interaction-mode-map map)
- (set-keymap-parent map guile-scheme-mode-map)
- (define-key map "\C-j" 'guile-scheme-eval-print-last-sexp)
- ))
-
-(defvar scheme-interaction-mode-hook nil
- "Normal hook run when entering `scheme-interaction-mode'.")
-
-(defun scheme-interaction-mode ()
- "Major mode for evaluating Scheme expressions with Guile.
-
-\\{scheme-interaction-mode-map}"
- (interactive)
- (guile-scheme-mode)
- (use-local-map scheme-interaction-mode-map)
- (setq major-mode 'scheme-interaction-mode)
- (setq mode-name "Scheme Interaction")
- (run-hooks 'scheme-interaction-mode-hook))
-
-
-;;;
-;;; Guile Scheme adapter
-;;;
-
-(defvar guile-scheme-command "guile")
-(defvar guile-scheme-adapter nil)
-(defvar guile-scheme-module nil)
-
-(defun guile-scheme-adapter ()
- (if (and (processp guile-scheme-adapter)
- (eq (process-status guile-scheme-adapter) 'run))
- guile-scheme-adapter
- (setq guile-scheme-module nil)
- (setq guile-scheme-adapter
- (guile:make-adapter guile-scheme-command 'emacs-scheme-channel))))
-
-(defun guile-scheme-set-module ()
- "Set the current module based on buffer contents.
-If there is a (define-module ...) form, evaluate it.
-Otherwise, choose module (guile-user)."
- (save-excursion
- (let ((module (if (re-search-backward "^(define-module " nil t)
- (let ((start (match-beginning 0)))
- (goto-char start)
- (forward-sexp)
- (buffer-substring-no-properties start (point)))
- "(define-module (emacs-user))")))
- (unless (string= guile-scheme-module module)
- (prog1 (guile:eval module (guile-scheme-adapter))
- (setq guile-scheme-module module))))))
-
-(defun guile-scheme-eval-string (string)
- (guile-scheme-set-module)
- (guile:eval string (guile-scheme-adapter)))
-
-(defun guile-scheme-display-result (value flag)
- (if (string= value "#<unspecified>")
- (setq value "done"))
- (if flag
- (insert value)
- (message "%s" value)))
-
-
-;;;
-;;; Interactive commands
-;;;
-
-(defun guile-scheme-eval-expression (string)
- "Evaluate the expression in STRING and show value in echo area."
- (interactive "SGuile Scheme Eval: ")
- (guile-scheme-display-result (guile-scheme-eval-string string) nil))
-
-(defun guile-scheme-eval-region (start end)
- "Evaluate the region as Guile Scheme code."
- (interactive "r")
- (guile-scheme-eval-expression (buffer-substring-no-properties start end)))
-
-(defun guile-scheme-eval-buffer ()
- "Evaluate the current buffer as Guile Scheme code."
- (interactive)
- (guile-scheme-eval-expression (buffer-string)))
-
-(defun guile-scheme-eval-last-sexp (arg)
- "Evaluate sexp before point; show value in echo area.
-With argument, print output into current buffer."
- (interactive "P")
- (guile-scheme-display-result
- (guile-scheme-eval-string
- (buffer-substring-no-properties
- (point) (save-excursion (backward-sexp) (point)))) arg))
-
-(defun guile-scheme-eval-print-last-sexp ()
- "Evaluate sexp before point; print value into current buffer."
- (interactive)
- (let ((start (point)))
- (guile-scheme-eval-last-sexp t)
- (insert "\n")
- (save-excursion (goto-char start) (insert "\n"))))
-
-(defun guile-scheme-eval-define ()
- (interactive)
- (guile-scheme-eval-region (save-excursion (end-of-defun) (point))
- (save-excursion (beginning-of-defun) (point))))
-
-(defun guile-scheme-load-file (file)
- "Load a Guile Scheme file."
- (interactive "fGuile Scheme load file: ")
- (guile-scheme-eval-string (format "(load %s)" (expand-file-name file)))
- (message "done"))
-
-(guile-import guile-emacs-complete-alist)
-
-(defun guile-scheme-complete-symbol ()
- (interactive)
- (let* ((end (point))
- (start (save-excursion (skip-syntax-backward "w_") (point)))
- (pattern (buffer-substring-no-properties start end))
- (alist (guile-emacs-complete-alist pattern)))
- (goto-char end)
- (let ((completion (try-completion pattern alist)))
- (cond ((eq completion t))
- ((not completion)
- (message "Can't find completion for \"%s\"" pattern)
- (ding))
- ((not (string= pattern completion))
- (delete-region start end)
- (insert completion))
- (t
- (message "Making completion list...")
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list alist))
- (message "Making completion list...done"))))))
-
-(guile-import guile-emacs-apropos)
-
-(defun guile-scheme-apropos (regexp)
- (interactive "sGuile Scheme apropos (regexp): ")
- (guile-scheme-set-module)
- (with-output-to-temp-buffer "*Help*"
- (princ (guile-emacs-apropos regexp))))
-
-(guile-import guile-emacs-describe)
-
-(defun guile-scheme-describe (symbol)
- (interactive (list (guile-scheme-input-symbol "Describe Guile variable")))
- (guile-scheme-set-module)
- (with-output-to-temp-buffer "*Help*"
- (princ (guile-emacs-describe symbol))))
-
-(defun guile-scheme-kill-process ()
- (interactive)
- (if guile-scheme-adapter
- (guile-process-kill guile-scheme-adapter))
- (setq guile-scheme-adapter nil))
-
-
-;;;
-;;; Internal functions
-;;;
-
-(guile-import apropos-internal guile-apropos-internal)
-
-(defvar guile-scheme-complete-table (make-vector 151 nil))
-
-(defun guile-scheme-input-symbol (prompt)
- (mapc (lambda (sym)
- (if (symbolp sym)
- (intern (symbol-name sym) guile-scheme-complete-table)))
- (guile-apropos-internal ""))
- (let* ((str (thing-at-point 'symbol))
- (default (if (intern-soft str guile-scheme-complete-table)
- (concat " (default " str ")")
- "")))
- (intern (completing-read (concat prompt default ": ")
- guile-scheme-complete-table nil t nil nil str))))
-
-
-;;;
-;;; Turn on guile-scheme-mode for .scm files by default.
-;;;
-
-(setq auto-mode-alist
- (cons '("\\.scm\\'" . guile-scheme-mode) auto-mode-alist))
-
-(provide 'guile-scheme)
-
-;;; guile-scheme.el ends here
diff --git a/emacs/guile.el b/emacs/guile.el
deleted file mode 100644
index 15f866fbb..000000000
--- a/emacs/guile.el
+++ /dev/null
@@ -1,215 +0,0 @@
-;;; guile.el --- Emacs Guile interface
-
-;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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.
-
-;;; Code:
-
-(require 'cl)
-
-;;;
-;;; Low level interface
-;;;
-
-(defvar guile-emacs-file
- (catch 'return
- (mapc (lambda (dir)
- (let ((file (expand-file-name "guile-emacs.scm" dir)))
- (if (file-exists-p file) (throw 'return file))))
- load-path)
- (error "Cannot find guile-emacs.scm")))
-
-(defvar guile-channel-file
- (catch 'return
- (mapc (lambda (dir)
- (let ((file (expand-file-name "channel.scm" dir)))
- (if (file-exists-p file) (throw 'return file))))
- load-path)
- (error "Cannot find channel.scm")))
-
-(defvar guile-libs
- (nconc (if guile-channel-file (list "-l" guile-channel-file) '())
- (list "-l" guile-emacs-file)))
-
-;;;###autoload
-(defun guile:make-adapter (command channel)
- (let* ((buff (generate-new-buffer " *guile object channel*"))
- (libs (if guile-channel-file (list "-l" guile-channel-file) nil))
- (proc (apply 'start-process "guile-oa" buff command "-q" guile-libs)))
- (process-kill-without-query proc)
- (accept-process-output proc)
- (guile-process-require proc (format "(%s)\n" channel) "channel> ")
- proc))
-
-(put 'guile-error 'error-conditions '(guile-error error))
-(put 'guile-error 'error-message "Guile error")
-
-(defvar guile-token-tag "<guile>")
-
-(defun guile-tokenp (x) (and (consp x) (eq (car x) guile-token-tag)))
-
-;;;###autoload
-(defun guile:eval (string adapter)
- (condition-case error
- (let ((output (guile-process-require adapter (concat "eval " string "\n")
- "channel> ")))
- (cond
- ((string= output "") nil)
- ((string-match "^\\(\\(value\\)\\|\\(token\\)\\|\\(exception\\)\\) = "
- output)
- (cond
- ;; value
- ((match-beginning 2)
- (car (read-from-string (substring output (match-end 0)))))
- ;; token
- ((match-beginning 3)
- (cons guile-token-tag
- (car (read-from-string (substring output (match-end 0))))))
- ;; exception
- ((match-beginning 4)
- (signal 'guile-error
- (car (read-from-string (substring output (match-end 0))))))))
- (t
- (error "Unsupported result" output))))
- (quit
- (signal-process (process-id adapter) 'SIGINT)
- (signal 'quit nil))))
-
-
-;;;
-;;; Guile Lisp adapter
-;;;
-
-(defvar guile-lisp-command "guile")
-(defvar guile-lisp-adapter nil)
-
-(defvar true "#t")
-(defvar false "#f")
-
-(unless (boundp 'keywordp)
- (defun keywordp (x) (and (symbolp x) (eq (aref (symbol-name x) 0) ?:))))
-
-(defun guile-lisp-adapter ()
- (if (and (processp guile-lisp-adapter)
- (eq (process-status guile-lisp-adapter) 'run))
- guile-lisp-adapter
- (setq guile-lisp-adapter
- (guile:make-adapter guile-lisp-command 'emacs-lisp-channel))))
-
-(defun guile-lisp-convert (x)
- (cond
- ((or (eq x true) (eq x false)) x)
- ((null x) "'()")
- ((keywordp x) (concat "#" (prin1-to-string x)))
- ((stringp x) (prin1-to-string x))
- ((guile-tokenp x) (cadr x))
- ((consp x)
- (if (null (cdr x))
- (list (guile-lisp-convert (car x)))
- (cons (guile-lisp-convert (car x)) (guile-lisp-convert (cdr x)))))
- (t x)))
-
-;;;###autoload
-(defun guile-lisp-eval (form)
- (guile:eval (format "%s" (guile-lisp-convert form)) (guile-lisp-adapter)))
-
-(defun guile-lisp-flat-eval (&rest form)
- (let ((args (mapcar (lambda (x)
- (if (guile-tokenp x) (cadr x) (list 'quote x)))
- (cdr form))))
- (guile-lisp-eval (cons (car form) args))))
-
-;;;###autoload
-(defmacro guile-import (name &optional new-name &rest opts)
- `(guile-process-import ',name ',new-name ',opts))
-
-(defun guile-process-import (name new-name opts)
- (let ((real (or new-name name))
- (docs (if (memq :with-docs opts) true false)))
- (eval (guile-lisp-eval `(guile-emacs-export ',name ',real ,docs)))))
-
-;;;###autoload
-(defmacro guile-use-module (name)
- `(guile-lisp-eval '(use-modules ,name)))
-
-;;;###autoload
-(defmacro guile-import-module (name &rest opts)
- `(guile-process-import-module ',name ',opts))
-
-(defun guile-process-import-module (name opts)
- (unless (boundp 'guile-emacs-export-procedures)
- (guile-import guile-emacs-export-procedures))
- (let ((docs (if (memq :with-docs opts) true false)))
- (guile-lisp-eval `(use-modules ,name))
- (eval (guile-emacs-export-procedures name docs))
- name))
-
-
-;;;
-;;; Process handling
-;;;
-
-(defvar guile-process-output-start nil)
-(defvar guile-process-output-value nil)
-(defvar guile-process-output-finished nil)
-(defvar guile-process-output-separator nil)
-
-(defun guile-process-require (process string separator)
- (setq guile-process-output-value nil)
- (setq guile-process-output-finished nil)
- (setq guile-process-output-separator separator)
- (let (temp-buffer)
- (unless (process-buffer process)
- (setq temp-buffer (guile-temp-buffer))
- (set-process-buffer process temp-buffer))
- (with-current-buffer (process-buffer process)
- (goto-char (point-max))
- (insert string)
- (setq guile-process-output-start (point))
- (set-process-filter process 'guile-process-filter)
- (process-send-string process string)
- (while (not guile-process-output-finished)
- (unless (accept-process-output process 3)
- (when (> (point) guile-process-output-start)
- (display-buffer (current-buffer))
- (error "BUG in Guile object channel!!")))))
- (when temp-buffer
- (set-process-buffer process nil)
- (kill-buffer temp-buffer)))
- guile-process-output-value)
-
-(defun guile-process-filter (process string)
- (with-current-buffer (process-buffer process)
- (insert string)
- (forward-line -1)
- (if (< (point) guile-process-output-start)
- (goto-char guile-process-output-start))
- (when (re-search-forward guile-process-output-separator nil 0)
- (goto-char (match-beginning 0))
- (setq guile-process-output-value
- (buffer-substring guile-process-output-start (point)))
- (setq guile-process-output-finished t))))
-
-(defun guile-process-kill (process)
- (set-process-filter process nil)
- (delete-process process)
- (if (process-buffer process)
- (kill-buffer (process-buffer process))))
-
-(provide 'guile)
-
-;;; guile.el ends here
diff --git a/emacs/multistring.el b/emacs/multistring.el
deleted file mode 100644
index 7b0ef30c1..000000000
--- a/emacs/multistring.el
+++ /dev/null
@@ -1,222 +0,0 @@
-;;; multistring.el --- editing multiline strings.
-
-;; Copyright (C) 2000 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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.
-
-;;; Author: Mikael Djurfeldt <djurfeldt@nada.kth.se>
-
-;;; Commentary:
-
-;; Commands for editing multiline ANSI C compatible string literals.
-
-;;; Code:
-
-(defun ms-ansify-string (arg)
- "Convert a string literal spanning multiple lines into multiple literals.
-With no argument, convert the single string at point to multiple strings.
-With an argument, convert multiple strings to a single one.
-
-ANSI C doesn't allow a string literal to span multiple lines. This
-function makes editing of multiline strings easier.
-
-The programmer can edit a string spanning multiple lines and then use
-this function to convert it into multiple literals representing the
-original string through the ANSI C string concatenation feature:
-
- \"A string consisting of
- multiple
- lines.\"
-
-is converted into
-
- \"A string consisting of\n\"
- \"multiple\n\"
- \"lines\""
- (interactive "*P")
- (save-excursion
- (let (beg end)
- (save-restriction
- (ms-narrow-canonicalize-ansi-c-string)
- (if (not arg)
- (ms-break-string))
- (setq beg (point-min))
- (setq end (point-max)))
- (if (not arg)
- (c-indent-region beg end)))))
-
-(defun ms-pack-region (from to &optional unpack-flag)
- "Pack paragraphs into single lines and remove one newline after paragraphs.
-With no argument, do the conversion.
-With an argument, do the reverse.
-
-When doing the reverse conversion, \\[fill-region] is used to break up
-the text into multiple lines."
- (interactive "*r\nP")
- (save-excursion
- (save-restriction
- (narrow-to-region from to)
- (if (not unpack-flag)
- (ms-pack-buffer)
- (ms-unpack-buffer)))))
-
-(defun ms-pack-ansify-string (arg)
- "Pack text in a string literal and convert into multiple literals.
-With no argument, do the conversion.
-With an argument, do the reverse.
-
-This command has the combined effect of \\[ms-pack-region] and
-\\[ms-ansify-string]. It is typically used if you want to store
-entire paragraphs without newlines in an ANSI C literal, but want to
-split it into multiple literals in order for the program text to look
-sensible. Using the reverse command, you can \"unpack\" the text,
-edit it and repack the text using the forward conversion."
- (interactive "*P")
- (save-excursion
- (let (beg end)
- (save-restriction
- (ms-narrow-canonicalize-ansi-c-string)
- (if (not arg)
- (ms-break-string " " "" "\\n")
- (ms-unpack-buffer))
- (setq beg (point-min))
- (setq end (point-max)))
- (if (not arg)
- (c-indent-region beg end)))))
-
-(defun ms-pack-buffer ()
- "Pack paragraphs into single lines and remove one newline after paragraphs."
- (interactive "*")
- (goto-char (point-min))
- (skip-chars-forward "^\n")
- (while (not (eobp))
- (delete-char 1)
- (skip-chars-forward "\n")
- (skip-chars-forward "^\n")))
-
-(defun ms-unpack-buffer ()
- "Break single lines into paragraphs and add an extra newline between each."
- (interactive "*")
- (goto-char (point-min))
- (skip-chars-forward "^\n")
- (while (not (eobp))
- (insert ?\n)
- (skip-chars-forward "\n")
- (skip-chars-forward "^\n"))
- (fill-region (point-min) (point-max) nil t))
-
-(defconst ms-whitespace " \t\n")
-(defconst ms-string-beginning "\"")
-(defconst ms-string-end "\\(\\\\*\\)\"")
-(defconst ms-quoted-newline "\\(\\\\*\\)\\(\\\\n\\)")
-
-(defun ms-in-string-p ()
- (eq (c-in-literal) 'string))
-
-(defun ms-narrow-canonicalize-ansi-c-string ()
- ;; Find and check reference point
- (cond ((ms-in-string-p))
- ((eq (char-after) ?\") (forward-char))
- (t (error "Not in string.")))
- (set-mark (point))
- ;; Find beginning
- (ms-beginning-of-string)
- (let ((beg (point)))
- ;; Extend string backwards
- (while (ms-extend-backwards)
- (setq beg (point)))
- (goto-char (mark))
- ;; Find end
- (ms-end-of-string)
- (let ((end (point)))
- ;; Extend string forwards
- (while (ms-extend-forwards)
- (setq end (point)))
- ;; Narrow
- (narrow-to-region beg end)
- ;; Convert \n into explicit newlines
- (ms-convert-quoted-newlines))))
-
-(defun ms-beginning-of-string ()
- (let ((pos (search-backward ms-string-beginning nil t)))
- (while (and pos
- (char-before)
- (eq (char-before) ?\\))
- (setq pos (search-backward ms-string-beginning nil t)))
- (if pos
- (progn
- (forward-char)
- (1+ pos)))))
-
-(defun ms-extend-backwards ()
- (let ((end (point)))
- (backward-char)
- (skip-chars-backward ms-whitespace)
- (if (eq (char-before) ?\")
- (progn
- (backward-char)
- (delete-region (point) end)
- (ms-beginning-of-string)))))
-
-(defun ms-end-of-string ()
- (let ((pos (search-forward-regexp ms-string-end nil t)))
- (while (and pos (= (logand (- (match-end 1) (match-beginning 1)) 1) 1))
- (setq pos (search-forward-regexp ms-string-end nil t)))
- (if pos
- (progn
- (backward-char)
- (match-end 1)))))
-
-(defun ms-extend-forwards ()
- (let ((start (point)))
- (forward-char)
- (skip-chars-forward ms-whitespace)
- (if (eq (char-after) ?\")
- (progn
- (forward-char)
- (delete-region start (point))
- (ms-end-of-string)))))
-
-(defun ms-convert-quoted-newlines ()
- (goto-char (point-min))
- (while (search-forward-regexp ms-quoted-newline nil t)
- (if (= (logand (- (match-end 1) (match-beginning 1)) 1) 0)
- (replace-match "\n" nil t nil 2))))
-
-(defun ms-break-string (&optional single-term multi-term-1 multi-term-n)
- (let ((single-term (or single-term "\\n"))
- (multi-term-1 (or multi-term-1 "\\n"))
- (multi-term-n (or multi-term-n "\\n")))
- (goto-char (point-min))
- (skip-chars-forward "^\n")
- (while (not (eobp))
- (delete-char 1)
- (if (not (eq (char-after) ?\n))
- (insert single-term)
- (insert multi-term-1)
- (while (eq (char-after) ?\n)
- (delete-char 1)
- (insert multi-term-n)))
- (insert "\"\n\"")
- (skip-chars-forward "^\n"))))
-
-(eval-after-load "cc-mode"
- (progn
- (define-key c-mode-base-map "\C-ca" 'ms-ansify-string)
- (define-key c-mode-base-map "\C-cd" 'ms-pack-ansify-string)
- ))
diff --git a/emacs/patch.el b/emacs/patch.el
deleted file mode 100644
index 868310a80..000000000
--- a/emacs/patch.el
+++ /dev/null
@@ -1,106 +0,0 @@
-;;; patch.el --- mail/apply a patch
-
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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.
-
-;;; Author: Thien-Thi Nguyen <ttn@gnu.org>
-;;; Version: 1
-;;; Favorite-Favorite: Favorite-Favorite
-
-;;; Commentary:
-
-;; This file has two symmetrical usage modes, for patch creation and
-;; application, respectively. The details are somewhat tuned for Guile
-;; maintenance; probably we should generalize it a bit and add it to
-;; Emacs proper at some point in the future. Long live free software!
-;;
-;; On the patch creation side of things, there are various version
-;; control systems that are happy to write a diff to stdout (and
-;; numerous Emacs interfaces to them all). Thus, we provide only a
-;; simple `patch-send' that composes mail from the current buffer;
-;; the contents of that buffer are left as an exercise for the patch
-;; creator. When preparing the mail, `patch-send' scans the patch
-;; for standard filename headers and sets up a skeleton change log --
-;; filling this in is a good way to earn respect from maintainers (hint
-;; hint). Type `C-c C-c' to send the mail when you are done. (See
-;; `compose-mail' for more info.)
-;;
-;; TODO: Write/document patch-apply side of things.
-;; TODO: Integrate w/ `ediff-patch-buffer' et al.
-
-;;; Code:
-
-(require 'cl)
-(require 'update-changelog) ; for stitching
-
-;; outgoing
-
-(defvar patch-greeting "hello guile maintainers,\n\n"
- "*String to insert at beginning of patch mail.")
-
-(defun patch-scan-files ()
- (let (files)
- (save-excursion
- (while (re-search-forward "^[+][+][+] \\(\\S-+\\)" (point-max) t)
- (setq files (cons (cons (match-string 1)
- (match-beginning 0))
- files))))
- (reverse files)))
-
-(defun patch-common-prefix (filenames)
- (let* ((first-file (car filenames))
- (prefix (and first-file (file-name-directory first-file))))
- (while (and prefix
- (not (string= "" prefix))
- (not (every (lambda (filename)
- (string-match (concat "^" prefix) filename))
- filenames)))
- (setq prefix (file-name-directory (substring prefix 0 -1))))
- prefix))
-
-(defun patch-changelog-skeleton ()
- (let* ((file-info (patch-scan-files))
- (fullpath-files (mapcar 'car file-info))
- (cut (length (patch-common-prefix fullpath-files)))
- (files (mapcar (lambda (fullpath-file)
- (substring fullpath-file cut))
- fullpath-files)))
- (mapconcat
- (lambda (file)
- (concat (make-string (length file) ?_) "\n" file "\n[writeme]"))
- files
- "\n")))
-
-(defun patch-send (buffer subject)
- (interactive "bBuffer: \nsSubject: ")
- (when (string= "" subject)
- (error "(empty subject)"))
- (compose-mail "bug-guile@gnu.org" subject)
- (insert (with-current-buffer buffer (buffer-string)))
- (mail-text)
- (insert patch-greeting)
- (save-excursion
- (insert "here is a patch ... [overview/observations/etc]\n\n"
- (patch-changelog-skeleton) "\n\n\n"
- (make-string 72 ?_) "\n")))
-
-;; incoming
-
-
-
-
-;;; patch.el ends here
diff --git a/emacs/ppexpand.el b/emacs/ppexpand.el
deleted file mode 100644
index 39e113fba..000000000
--- a/emacs/ppexpand.el
+++ /dev/null
@@ -1,94 +0,0 @@
-;;; ppexpand.el --- temporarily expanding macros in a pretty way.
-
-;; Copyright (C) 2000 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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.
-
-;; GNU Emacs 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.
-
-;;; Author: Mikael Djurfeldt <djurfeldt@nada.kth.se>
-
-;;; Commentary:
-
-;; Commands for editing multiline ANSI C compatible string literals.
-
-;;; Code:
-(require 'cmacexp)
-
-(defvar if-mark "#if 0 /* PPEXPAND */")
-(defvar else-mark "#else /* PPEXPAND */")
-(defvar endif-mark "#endif /* PPEXPAND */")
-
-(define-key c-mode-map "\C-ce" 'ppexpand)
-
-(defun ppexpand (start end &optional undo)
- "Expand C macros in the region, using the C preprocessor.
-The expanded code is run through the `indent' command and inserted
-into the program next to the original code, using an #if/#else/#endif
-construct.
-
-Given a prefix argument, it reverts the change, removing the
-#if/#else/#endif construct and the expanded code.
-
-`c-macro-preprocessor' specifies the preprocessor to use.
-Prompt for arguments to the preprocessor \(e.g. `-DDEBUG -I ./include')
-if the user option `c-macro-prompt-flag' is non-nil.
-
-Noninteractive args are START, END, UNDO.
-For use inside Lisp programs, see also `c-macro-expansion'."
-
- (interactive (if current-prefix-arg
- (list nil nil t)
- (let ((pos1 (point))
- (pos2 (mark)))
- (if (< pos1 pos2)
- (list pos1 pos2 nil)
- (list pos2 pos1 nil)))))
- (let ((inbuf (current-buffer)))
- ;; Build the command string.
- (if c-macro-prompt-flag
- (setq c-macro-cppflags
- (read-string "Preprocessor arguments: "
- c-macro-cppflags)))
- (if undo
- (let ((pos (point)) if-pos else-pos endif-pos)
- (save-excursion
- (end-of-line)
- (if (not (and (setq if-pos (search-backward if-mark nil t))
- (setq else-pos (search-forward else-mark nil t))
- (setq endif-pos (search-forward endif-mark nil t))
- (<= if-pos pos)
- (< pos endif-pos)))
- (error "Not in ppexpanded region"))
- (let ((orig (buffer-substring (+ if-pos (length if-mark) 1)
- (- else-pos (length else-mark)))))
- (delete-region if-pos (+ endif-pos 1))
- (insert orig))))
- ;; Expand the macro.
- (let* ((expansion (c-macro-expansion start end
- (concat c-macro-preprocessor " "
- c-macro-cppflags) t))
- (orig (buffer-substring start end)))
- (setq expansion
- (with-temp-buffer
- (insert expansion)
- (call-process-region (point-min) (point-max) "indent"
- t ;delete the text
- t ;output --> current buffer
- )
- (buffer-string)))
- (delete-region start end)
- (insert if-mark ?\n orig else-mark ?\n expansion endif-mark ?\n)))))
diff --git a/emacs/update-changelog.el b/emacs/update-changelog.el
deleted file mode 100644
index f9e4ff2ac..000000000
--- a/emacs/update-changelog.el
+++ /dev/null
@@ -1,145 +0,0 @@
-;;; update-changelog.el --- stitch rcs2log output to ChangeLog
-
-;;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; 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 this program; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Usage: emacs -batch -l update-changelog.el
-;;
-;; This program is basically a wrapper around rcs2log, and inherits rcs2log's
-;; weaknesses, namely, the requirement that there be a checked out (working
-;; directory) copy. It would be nice if rcs2log grokked with the repository
-;; directly, but until then, we work around it by requiring the environment
-;; var `LOCAL_WORK_ROOT' to be defined. This should be a directory under
-;; which cvs modules are checked out.
-;;
-;; Flash! Newer versions of rcs2log do indeed understand the repository,
-;; and can be invoked with "-R" therein. We infer this if `LOCAL_WORK_ROOT'
-;; is not set, and use instead `CVSROOT'. At least one of these must be set.
-;;
-;; You can pass additional options to rcs2log using env var `RCS2LOG_OPTS'.
-;;
-;; Usage from a Lisp program:
-;; (ucl-update filename) -- Update FILENAME, a Change Log file
-
-;;; Code:
-
-;;;---------------------------------------------------------------------------
-;;; Variables
-
-(defvar ucl-o (or (getenv "RCS2LOG_OPTS") "")
- "Additional options to pass to rcs2log.")
-
-;;;---------------------------------------------------------------------------
-;;; Cleanup functions
-
-(defun ucl-stitch-new-old (new-old &rest ignore)
- "In a changelog buffer, remove redundancy around NEW-OLD point.
-The new text is before NEW-OLD point, and the old after."
- (goto-char new-old)
- (or (= new-old (point-max)) ; no old
- (let ((last-new
- (save-excursion
- (buffer-substring (re-search-backward "^[0-9]+") new-old))))
- (let ((has-diff (string-match "\n\tdiff.*-r" last-new))) ; ugh
- (and has-diff (setq last-new (substring last-new 0 has-diff))))
- (let ((overlap (search-forward last-new (point-max) t)))
- (and overlap (delete-region new-old overlap))))))
-
-;; Sometimes wannabe developers append diffs to their log entries.
-(defun ucl-omit-diffs (&rest ignore)
- "In a changelog buffer, delete diffs (assumed at end of entry)."
- (goto-char (point-min))
- (while (re-search-forward "^\tdiff .*-r" (point-max) t)
- (beginning-of-line)
- (delete-region (point)
- (save-excursion
- (if (re-search-forward "^[0-9]+" (point-max))
- (- (point) 4)
- (point-max))))))
-
-(defun ucl-space-out-entries (&rest ignore)
- "In a changelog buffer, ensure proper spacing between entries."
- (goto-char (point-max))
- (while (re-search-backward "^[0-9]+" (point-min) t)
- (unless (= (point) (point-min))
- (open-line 3) ; yuk
- (delete-blank-lines))))
-
-(defun ucl-kill-eol-white-space (&rest ignore)
- "In a changelog buffer, delete end-of-line white space."
- (goto-char (point-min))
- (while (re-search-forward "[ \t]+$" (point-max) t)
- (delete-region
- (match-beginning 0) (match-end 0))))
-
-(defvar ucl-cleanup-hook '(ucl-stitch-new-old
- ucl-omit-diffs
- ucl-space-out-entries
- ucl-kill-eol-white-space)
- "Hook run after combining the new fragment with the old changelog. These
-are called with the argument NEW-OLD, which is the buffer position at the
-boundary of the two pieces of text. This is suboptimal; we should use a
-marker so that munges on the text do not lose this position. The result is
-that currently, `ucl-stitch-new-old' must be called first because it depends
-on NEW-OLD, while the other cleanup funcs ignore it. (Sigh.)")
-
-;;;---------------------------------------------------------------------------
-;;; Update functions
-
-(defun ucl-root ()
- (let ((lwr (getenv "LOCAL_WORK_ROOT"))
- (cr (getenv "CVSROOT")))
- (concat (or lwr
- (and cr (progn
- (setq ucl-o (concat "-R " ucl-o)) ; hmm
- cr))
- (error "Must set env var LOCAL_WORK_ROOT or CVSROOT"))
- "/")))
-
-(defun ucl-update (filename)
- (interactive "fChangeLog: ")
- (let* ((ofile (expand-file-name filename))
- (cmd (concat "rcs2log " ucl-o " -c " ofile))
- (obuf "*ucl-work*"))
- (when (and (file-exists-p ofile)
- (progn
- (shell-command cmd obuf)
- (get-buffer obuf)))
- (save-excursion ; prevent default-directory hosing
- (set-buffer obuf)
- (unless (= 0 (buffer-size))
- (let ((new-old-boundary (point-max)))
- (goto-char new-old-boundary)
- (insert-file ofile)
- (run-hook-with-args 'ucl-cleanup-hook new-old-boundary))
- (or (= (buffer-size) (nth 7 (file-attributes ofile)))
- (let (make-backup-files) ; less clutter
- (write-file ofile))))
- (kill-buffer (current-buffer))))))
-
-;;;---------------------------------------------------------------------------
-;;; Load-time actions
-
-(when noninteractive ; only when `-batch'
- (or (ucl-update "ChangeLog")
- (message "Sorry, could not update ChangeLog in %s" default-directory)))
-
-(provide 'update-changelog)
-
-;;; update-changelog.el ends here