Mercurial > urweb

annotate src/elisp/urweb-util.el @ 1739:c414850f206f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add support for -boot flag, which allows in-tree execution of Ur/Web The boot flag rewrites most hardcoded paths to point to the build directory, and also forces static compilation. This is convenient for developing Ur/Web, or if you cannot 'sudo make install' Ur/Web. The following changes were made: * Header files were moved to include/urweb instead of include; this lets FFI users point their C_INCLUDE_PATH at this directory at write <urweb/urweb.h>. For internal Ur/Web executables, we simply pass -I$PATH/include/urweb as normal. * Differentiate between LIB and SRCLIB; SRCLIB is Ur and JavaScript source files, while LIB is compiled products from libtool. For in-tree compilation these live in different places. * No longer reference Config for paths; instead use Settings; these settings can be changed dynamically by Compiler.enableBoot () (TODO: add a disableBoot function.) * config.h is now generated directly in include/urweb/config.h, for consistency's sake (especially since it gets installed along with the rest of the headers!) * All of the autotools build products got updated. * The linkStatic field in protocols now only contains the name of the build product, and not the absolute path. Future users have to be careful not to reference the Settings files to early, lest they get an old version (this was the source of two bugs during development of this patch.)
author Edward Z. Yang <ezyang@mit.edu>
date Wed, 02 May 2012 17:17:57 -0400
parents 3a1e36b14105
children
rev   line source
adamc@350 1 ;;; urweb-util.el --- Utility functions for urweb-mode
adamc@350 2
adamc@350 3 ;; Based on sml-mode:
adamc@350 4 ;; Copyright (C) 1999-2000 Stefan Monnier <monnier@cs.yale.edu>
adamc@350 5 ;;
adamc@350 6 ;; Modified for urweb-mode:
adamc@350 7 ;; Copyright (C) 2008 Adam Chlipala <adamc@hcoop.net>
adamc@350 8 ;;
adamc@350 9 ;; This program is free software; you can redistribute it and/or modify
adamc@350 10 ;; it under the terms of the GNU General Public License as published by
adamc@350 11 ;; the Free Software Foundation; either version 2 of the License, or
adamc@350 12 ;; (at your option) any later version.
adamc@350 13 ;;
adamc@350 14 ;; This program is distributed in the hope that it will be useful,
adamc@350 15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
adamc@350 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
adamc@350 17 ;; GNU General Public License for more details.
adamc@350 18 ;;
adamc@350 19 ;; You should have received a copy of the GNU General Public License
adamc@350 20 ;; along with this program; if not, write to the Free Software
adamc@350 21 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
adamc@350 22
adamc@350 23
adamc@350 24 ;;; Commentary:
adamc@350 25
adamc@350 26 ;;; Code:
adamc@350 27
adamc@350 28 (require 'cl) ;for `reduce'
adamc@350 29 (require 'urweb-compat)
adamc@350 30
adamc@350 31 ;;
adamc@350 32
adamc@350 33 (defun flatten (ls &optional acc)
adamc@350 34 (if (null ls) acc
adamc@350 35 (let ((rest (flatten (cdr ls) acc))
adamc@350 36 (head (car ls)))
adamc@350 37 (if (listp head)
adamc@350 38 (flatten head rest)
adamc@350 39 (cons head rest)))))
adamc@350 40
adamc@350 41 (defun urweb-preproc-alist (al)
adamc@350 42 "Expand an alist AL where keys can be lists of keys into a normal one."
adamc@350 43 (reduce (lambda (x al)
adamc@350 44 (let ((k (car x))
adamc@350 45 (v (cdr x)))
adamc@350 46 (if (consp k)
adamc@350 47 (append (mapcar (lambda (y) (cons y v)) k) al)
adamc@350 48 (cons x al))))
adamc@350 49 al
adamc@350 50 :initial-value nil
adamc@350 51 :from-end t))
adamc@350 52
adamc@350 53 ;;;
adamc@350 54 ;;; defmap
adamc@350 55 ;;;
adamc@350 56
adamc@350 57 (defun custom-create-map (m bs args)
adamc@350 58 (let (inherit dense suppress)
adamc@350 59 (while args
adamc@350 60 (let ((key (first args))
adamc@350 61 (val (second args)))
adamc@350 62 (cond
adamc@350 63 ((eq key :dense) (setq dense val))
adamc@350 64 ((eq key :inherit) (setq inherit val))
adamc@350 65 ((eq key :group) )
adamc@350 66 ;;((eq key :suppress) (setq suppress val))
adamc@350 67 (t (message "Uknown argument %s in defmap" key))))
adamc@350 68 (setq args (cddr args)))
adamc@350 69 (unless (keymapp m)
adamc@350 70 (setq bs (append m bs))
adamc@350 71 (setq m (if dense (make-keymap) (make-sparse-keymap))))
adamc@350 72 (dolist (b bs)
adamc@350 73 (let ((keys (car b))
adamc@350 74 (binding (cdr b)))
adamc@350 75 (dolist (key (if (consp keys) keys (list keys)))
adamc@350 76 (cond
adamc@350 77 ((symbolp key)
adamc@350 78 (substitute-key-definition key binding m global-map))
adamc@350 79 ((null binding)
adamc@350 80 (unless (keymapp (lookup-key m key)) (define-key m key binding)))
adamc@350 81 ((let ((o (lookup-key m key)))
adamc@350 82 (or (null o) (numberp o) (eq o 'undefined)))
adamc@350 83 (define-key m key binding))))))
adamc@350 84 (cond
adamc@350 85 ((keymapp inherit) (set-keymap-parent m inherit))
adamc@350 86 ((consp inherit) (set-keymap-parents m inherit)))
adamc@350 87 m))
adamc@350 88
adamc@350 89 (defmacro defmap (m bs doc &rest args)
adamc@350 90 `(defconst ,m
adamc@350 91 (custom-create-map (if (boundp ',m) ,m) ,bs ,(cons 'list args))
adamc@350 92 ,doc))
adamc@350 93
adamc@350 94 ;; defsyntax ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
adamc@350 95
adamc@350 96 (defun custom-create-syntax (css args)
adamc@350 97 (let ((st (make-syntax-table (cadr (memq :copy args)))))
adamc@350 98 (dolist (cs css)
adamc@350 99 (let ((char (car cs))
adamc@350 100 (syntax (cdr cs)))
adamc@350 101 (if (sequencep char)
adamc@350 102 (mapcar* (lambda (c) (modify-syntax-entry c syntax st)) char)
adamc@350 103 (modify-syntax-entry char syntax st))))
adamc@350 104 st))
adamc@350 105
adamc@350 106 (defmacro defsyntax (st css doc &rest args)
adamc@350 107 `(defconst ,st (custom-create-syntax ,css ,(cons 'list args)) ,doc))
adamc@350 108
adamc@350 109 ;;;;
adamc@350 110 ;;;; Compatibility info
adamc@350 111 ;;;;
adamc@350 112
adamc@350 113 (defvar urweb-builtin-nested-comments-flag
adamc@350 114 (ignore-errors
adamc@350 115 (not (equal (let ((st (make-syntax-table)))
adamc@350 116 (modify-syntax-entry ?\* ". 23n" st) st)
adamc@350 117 (let ((st (make-syntax-table)))
adamc@350 118 (modify-syntax-entry ?\* ". 23" st) st))))
adamc@350 119 "Non-nil means this Emacs understands the `n' in syntax entries.")
adamc@350 120
adamc@350 121 (provide 'urweb-util)
adamc@350 122
adamc@350 123 ;;; urweb-util.el ends here