[climacs-cvs] CVS climacs
thenriksen
thenriksen at common-lisp.net
Sun Apr 23 12:11:26 UTC 2006
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv28674
Modified Files:
syntax.lisp packages.lisp misc-commands.lisp lisp-syntax.lisp
file-commands.lisp climacs.asd
Log Message:
Added support for local options lines (the -*- ... -*- stuff), the
generic option Syntax/Mode and Base and Package options for Lisp
syntax.
--- /project/climacs/cvsroot/climacs/syntax.lisp 2005/11/14 16:30:13 1.61
+++ /project/climacs/cvsroot/climacs/syntax.lisp 2006/04/23 12:11:26 1.62
@@ -208,6 +208,38 @@
(:default-initargs :command-table ',command-table , at default-initargs)
, at defclass-options))))
+(defgeneric eval-option (syntax name value)
+ (:documentation "Evaluate the option `name' with the specified
+ `value' for `syntax'.")
+ (:method (syntax name value)
+ ;; We do not want to error out if an invalid option is
+ ;; specified. Signal a condition? For now, silently ignore.
+ (declare (ignore syntax name value))))
+
+(defmethod eval-option :around (syntax (name string) value)
+ ;; Convert the name to a keyword symbol...
+ (eval-option syntax (intern name (find-package :keyword))
+ value))
+
+(defmacro define-option-for-syntax
+ (syntax option-name (syntax-symbol value-symbol) &body body)
+ "Define an option for the syntax specified by the symbol
+ `syntax'. `Option-name' should be a string that will be the
+ name of the option. The name will automatically be converted to
+ uppercase. When the option is being evaluated, `body' will be
+ run, with `syntax-symbol' bound to the syntax object the option
+ is being evaluated for, and `value-symbol' bound to the value
+ of the option."
+ ;; The name is converted to a keyword symbol which is used for all
+ ;; further identification.
+ (let ((name-symbol (gensym))
+ (symbol (intern (string-upcase option-name)
+ (find-package :keyword))))
+ `(defmethod eval-option ((,syntax-symbol ,syntax)
+ (,name-symbol (eql ,symbol))
+ ,value-symbol)
+ , at body)))
+
#+nil
(defmacro define-syntax (class-name (name superclasses) &body body)
`(progn (push '(,name . ,class-name) *syntaxes*)
--- /project/climacs/cvsroot/climacs/packages.lisp 2006/03/26 14:14:48 1.87
+++ /project/climacs/cvsroot/climacs/packages.lisp 2006/04/23 12:11:26 1.88
@@ -94,6 +94,8 @@
(defpackage :climacs-syntax
(:use :clim-lisp :clim :climacs-buffer :climacs-base :flexichain)
(:export #:syntax #:define-syntax
+ #:eval-option
+ #:define-option-for-syntax
#:syntax-from-name
#:basic-syntax
#:update-syntax #:update-syntax-for-display
--- /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/03/26 14:14:48 1.5
+++ /project/climacs/cvsroot/climacs/misc-commands.lisp 2006/04/23 12:11:26 1.6
@@ -28,6 +28,13 @@
(in-package :climacs-gui)
+(define-command (com-reload-local-options-line
+ :name t
+ :command-table buffer-table)
+ ()
+ "Reload the local options line."
+ (evaluate-local-options-line (current-buffer)))
+
(define-command (com-overwrite-mode :name t :command-table editing-table) ()
(with-slots (overwrite-mode) (current-window)
(setf overwrite-mode (not overwrite-mode))))
--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/04/13 10:47:48 1.51
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/04/23 12:11:26 1.52
@@ -42,11 +42,31 @@
(current-start-mark)
(current-size)
(scan)
- (package))
+ (package)
+ (base :accessor base
+ :initform 10
+ :documentation "The base which numbers in the buffer are
+ expected to be in.")
+ (option-specified-package :accessor option-specified-package
+ :initform nil
+ :documentation "The package
+ specified in the local options
+ line (may be overridden
+ by (in-package) forms)."))
(:name "Lisp")
(:pathname-types "lisp" "lsp" "cl")
(:command-table lisp-table))
+(define-option-for-syntax lisp-syntax "Package" (syntax package-name)
+ (let ((specified-package (find-package package-name)))
+ (when specified-package
+ (setf (option-specified-package syntax) specified-package))))
+
+(define-option-for-syntax lisp-syntax "Base" (syntax base)
+ (let ((integer-base (parse-integer base :junk-allowed t)))
+ (when integer-base
+ (setf (base syntax) integer-base))))
+
(defmethod initialize-instance :after ((syntax lisp-syntax) &rest args)
(declare (ignore args))
(with-slots (buffer scan) syntax
--- /project/climacs/cvsroot/climacs/file-commands.lisp 2006/03/27 15:43:17 1.5
+++ /project/climacs/cvsroot/climacs/file-commands.lisp 2006/04/23 12:11:26 1.6
@@ -129,6 +129,67 @@
:key #'climacs-syntax::syntax-description-pathname-types))
'basic-syntax))
+(defun parse-local-options-line (line)
+ "Parse the local options line `line' and return an alist
+ mapping options to values. All option names will be coerced to
+ uppercase. `Line' must be stripped of the leading and
+ terminating -*- tokens."
+ (loop for pair in (split-sequence:split-sequence #\; line)
+ when (find #\: pair)
+ collect (destructuring-bind (key value)
+ (loop for elem in (split-sequence:split-sequence #\: pair)
+ collecting (string-trim " " elem))
+ (list (string-upcase key) value))))
+
+(defun evaluate-local-options (buffer options)
+ "Evaluate the local options `options' and modify `buffer' as
+ appropriate. `Options' should be an alist mapping option names
+ to their values."
+ ;; First, check whether we need to change the syntax (via the SYNTAX
+ ;; option). MODE is an alias for SYNTAX for compatibility with
+ ;; Emacs. If there is more than one option with one of these names,
+ ;; only the first will be acted upon.
+ (let ((specified-syntax
+ (syntax-from-name
+ (second (find-if #'(lambda (name)
+ (or (string= name "SYNTAX")
+ (string= name "MODE")))
+ options
+ :key #'first)))))
+ (when specified-syntax
+ (setf (syntax buffer)
+ (make-instance specified-syntax
+ :buffer buffer))))
+ ;; Now we iterate through the options (discarding SYNTAX and MODE
+ ;; options).
+ (loop for (name value) in options
+ unless (or (string= name "SYNTAX")
+ (string= name "MODE"))
+ do (eval-option (syntax buffer) name value)))
+
+(defun evaluate-local-options-line (buffer)
+ "Evaluate the local options line of `buffer'. If `buffer' does
+ not have a local options line, this function is a no-op."
+ ;; This could be simplified a bit by using regexps.
+ (let* ((beginning-mark (beginning-of-buffer
+ (clone-mark (point buffer))))
+ (end-mark (end-of-line (clone-mark beginning-mark)))
+ (line (buffer-sequence buffer (offset beginning-mark) (offset end-mark)))
+ (first-occurence (search "-*-" line))
+ (second-occurence
+ (when first-occurence
+ (search "-*-" line :start2 (1+ first-occurence)))))
+ (when (and first-occurence
+ second-occurence)
+ ;; Strip away the -*-s.
+ (let ((cleaned-options-line (coerce (subseq line
+ (+ first-occurence 3)
+ second-occurence)
+ 'string)))
+ (evaluate-local-options
+ buffer
+ (parse-local-options-line cleaned-options-line))))))
+
;; Adapted from cl-fad/PCL
(defun directory-pathname-p (pathspec)
"Returns NIL if PATHSPEC does not designate a directory."
@@ -153,13 +214,19 @@
(pane (current-window)))
(setf (offset (point (buffer pane))) (offset (point pane)))
(setf (buffer (current-window)) buffer)
- (setf (syntax buffer)
- (make-instance (syntax-class-name-for-filepath filepath)
- :buffer buffer))
;; Don't want to create the file if it doesn't exist.
(when (probe-file filepath)
(with-open-file (stream filepath :direction :input)
- (input-from-stream stream buffer 0)))
+ (input-from-stream stream buffer 0))
+ ;; A file! That means we may have a local options
+ ;; line to parse.
+ (evaluate-local-options-line buffer))
+ ;; If the local options line didn't set a syntax, do
+ ;; it now.
+ (when (null (syntax buffer))
+ (setf (syntax buffer)
+ (make-instance (syntax-class-name-for-filepath filepath)
+ :buffer buffer)))
(setf (filepath buffer) filepath
(name buffer) (filepath-filename filepath)
(needs-saving buffer) nil)
--- /project/climacs/cvsroot/climacs/climacs.asd 2006/03/25 21:15:21 1.43
+++ /project/climacs/cvsroot/climacs/climacs.asd 2006/04/23 12:11:26 1.44
@@ -28,7 +28,7 @@
(defparameter *climacs-directory* (directory-namestring *load-truename*))
(defsystem :climacs
- :depends-on (:mcclim :flexichain :esa)
+ :depends-on (:mcclim :flexichain :esa :split-sequence)
:components
((:module "cl-automaton"
:components ((:file "automaton-package")
More information about the Climacs-cvs
mailing list