Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/sml-mode/sml-util.el
ViewVC logotype

View of /sml/trunk/sml-mode/sml-util.el

Parent Directory Parent Directory | Revision Log Revision Log


Revision 535 - (download) (annotate)
Fri Feb 18 16:49:10 2000 UTC (20 years, 8 months ago) by monnier
File size: 3651 byte(s)
* sml-util.el (make-temp-dir, make-temp-file, temp-file-dir,
  delete-temp-dirs): Replaced by the make-temp-file from Emacs-21.
(custom-create-map): add :group arg and allow key to be a list.
(define-major-mode): Removed (use define-derived-mode instead).
(sml-builtin-nested-comments-flag): New var.

* sml-proc.el (sml-host-name): New var.
(sml-make-file-name): Replaced by `sml-compile-commands'.
(sml-config-file): New var.
(sml-compile-commands-alist): New var.
(inferior-sml-load-hook): Removed.
(sml-buffer): Query if the current buffer is not a *sml*.
(inferior-sml-mode): Use minor-mode-overriding-map-alist to disable
  compilation-minor-mode's keybindings.
(run-sml): Turn into an alias for sml-run.
(sml-run): Query the user for the command.  If prefix is set (or if
  default value is not null) query for args and host.  Use `split-string'
  rather than our own function.  Run cmd on another host if requested and
  pass it an init file if it exists.  Pop to the buffer at the end.
(sml-args-to-list): Remove.
(sml-compile): Look for special files (sml-compile-command-alist) in
  the current dir (and its parents) to choose a default command.  Remember
  the command for next time in the same buffer.  Make the `cd' explicit in
  the command so the user can change it.
(sml-make-error): Fix for when `endline' is absent.

* sml-mode.el: Pass it rhough checkdoc.
(sml-mode-version): Remove.
(sml-load-hook): Remove.
(sml-mode-info): Use `info' rather than `Info-goto-node'.
(sml-keywords-regexp): Add "o".
(sml-syntax-prop-table): Use `defsyntax'.
(sml-font-lock-syntactic-keywords): Only use nested comments if supported.
(sml-mode): Use `define-derived-mode'.
(sml-electric-pipe): `sml-indent-line' -> `indent-according-to-mode'.
(sml-indent-line): Use `indent-line-to'.
(sml-cm-mode): New mode for CM files.

* Makefile: Update.

* sml-mode-startup.el: Remove since it's now autogenerated.

* sml-defs.el (sml-bindings): Remove left over C-c` binding.
(sml-mode-map): Add binding for sml-drag-region (was in sml-proc.el).
(sml-mode-syntax-table): Only use nested comments if supported.
(sml-mode-menu): Use next-error rather than the old sml-next-error.
(sml-pipehead-re): Remove "of".

* sml-compat.el (set-keymap-=parents): Make sure it also works when called
  with a single keymap rather than a list.
(temporary-file-directory): Add a default definition for XEmacs.
(make-temp-file): New function.
;;; sml-util.el

(defconst rcsid-sml-util "@(#)$Name$:$Id$")

;; Copyright (C) 1999-1999  Stefan Monnier <monnier@cs.yale.edu>
;;
;; 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 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

(require 'cl)
(require 'sml-compat)

;;

(defmacro concatq (&rest ss)
  "Concatenate all the arguments and make the result a string.
As opposed to `concat', `concatq' does not evaluate its arguments
and is hence executed at macro-expansion-time."
  (apply 'concat ss))

(defun flatten (ls &optional acc)
  (if (null ls) acc
    (let ((rest (flatten (cdr ls) acc))
	  (head (car ls)))
      (if (listp head)
	  (flatten head rest)
	(cons head rest)))))

(defun sml-preproc-alist (al)
  "Expand an alist where keys can be lists of keys into a normal one."
  (reduce (lambda (x al)
	    (let ((k (car x))
		  (v (cdr x)))
	      (if (consp k)
		  (append (mapcar (lambda (y) (cons y v)) k) al)
		(cons x al))))
	  al
	  :initial-value nil
	  :from-end t))

;;; 
;;; defmap
;;; 

(defun custom-create-map (m bs args)
  (let (inherit dense suppress)
    (while args
      (let ((key (first args))
	    (val (second args)))
	(cond
	 ((eq key :dense) (setq dense val))
	 ((eq key :inherit) (setq inherit val))
	 ((eq key :group) )
	 ;;((eq key :suppress) (setq suppress val))
	 (t (message "Uknown argument %s in defmap" key))))
      (setq args (cddr args)))
    (unless (keymapp m)
      (setq bs (append m bs))
      (setq m (if dense (make-keymap) (make-sparse-keymap))))
    (dolist (b bs)
      (let ((keys (car b))
	    (binding (cdr b)))
	(dolist (key (if (consp keys) keys (list keys)))
	  (cond
	   ((symbolp key)
	    (substitute-key-definition key binding m global-map))
	   ((null binding)
	    (unless (keymapp (lookup-key m key)) (define-key m key binding)))
	   ((let ((o (lookup-key m key)))
	      (or (null o) (numberp o) (eq o 'undefined)))
	    (define-key m key binding))))))
    (cond
     ((keymapp inherit) (set-keymap-parent m inherit))
     ((consp inherit) (set-keymap-parents m inherit)))
    m))

(defmacro defmap (m bs doc &rest args)
  `(defconst ,m
     (custom-create-map (if (boundp ',m) ,m) ,bs ,(cons 'list args))
     ,doc))

;; defsyntax ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun custom-create-syntax (css args)
  (let ((st (make-syntax-table (cadr (memq :copy args)))))
    (dolist (cs css)
      (let ((char (car cs))
	    (syntax (cdr cs)))
	(if (sequencep char)
	    (mapcar* (lambda (c) (modify-syntax-entry c syntax st)) char)
	  (modify-syntax-entry char syntax st))))
    st))

(defmacro defsyntax (st css doc &rest args)
  `(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) doc))

;;;; 
;;;; Compatibility info
;;;; 

(defvar sml-builtin-nested-comments-flag
  (ignore-errors
    (not (equal (let ((st (make-syntax-table)))
		  (modify-syntax-entry ?\* ". 23n" st) st)
		(let ((st (make-syntax-table)))
		  (modify-syntax-entry ?\* ". 23" st) st))))
  "Whether this Emacs understands the `n' in syntax entries.")

;;
(provide 'sml-util)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0