diff options
author | cvs2svn <admin@example.com> | 2002-08-04 00:18:34 +0000 |
---|---|---|
committer | cvs2svn <admin@example.com> | 2002-08-04 00:18:34 +0000 |
commit | 2f4c89c4f475d3b2c718cbd4332c650214488ff9 (patch) | |
tree | 5abd57b1ace53b0c6970da9395f15d80d5f79430 /emacs | |
parent | c7743d027a335eae585335b959e483c5a6c38d36 (diff) | |
download | guile-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/ChangeLog | 89 | ||||
-rw-r--r-- | emacs/README | 13 | ||||
-rw-r--r-- | emacs/gud-guile.el | 81 | ||||
-rw-r--r-- | emacs/guile-c.el | 178 | ||||
-rw-r--r-- | emacs/guile-emacs.scm | 154 | ||||
-rw-r--r-- | emacs/guile-scheme.el | 346 | ||||
-rw-r--r-- | emacs/guile.el | 215 | ||||
-rw-r--r-- | emacs/multistring.el | 222 | ||||
-rw-r--r-- | emacs/patch.el | 106 | ||||
-rw-r--r-- | emacs/ppexpand.el | 94 | ||||
-rw-r--r-- | emacs/update-changelog.el | 145 |
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 |