Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 141 lines (128 sloc) 5.872 kB
6140761 Added support for "modes" (roughly similar to Emacs' minor-modes) to …
Troels Henriksen authored
1 ;;; -*- Mode: Lisp; Package: DREI -*-
2
3 ;;; (c) copyright 2007-2008 by
4 ;;; Troels Henriksen (athas@sigkill.dk)
5
6 ;;; This library is free software; you can redistribute it and/or
7 ;;; modify it under the terms of the GNU Library General Public
8 ;;; License as published by the Free Software Foundation; either
9 ;;; version 2 of the License, or (at your option) any later version.
10 ;;;
11 ;;; This library is distributed in the hope that it will be useful,
12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;; Library General Public License for more details.
15 ;;;
16 ;;; You should have received a copy of the GNU Library General Public
17 ;;; License along with this library; if not, write to the
18 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 ;;; Boston, MA 02111-1307 USA.
20 ;;;
21 ;;; This file contains the implementation of the infrastructure for
22 ;;; Drei "modes", loosely equivalent to Emacs minor modes. They modify
23 ;;; aspects of the behavior of a view or syntax.
24
25 (in-package :drei)
26
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;;;
29 ;;; The general mode protocol and macros.
30
31 (defvar *global-modes* '()
32 "A list of the names of modes globally available to Drei
33 instances. Do not use this list to retrieve modes, use the
34 function `available-modes' instead. The modes on this list are
35 available to all Drei variants.")
36
37 (defun applicable-modes (drei)
38 "Return a list of the names of all modes applicable for
39 `drei'."
40 (remove-if-not #'(lambda (mode)
41 (mode-applicable-p (view drei) mode))
42 (available-modes drei)))
43
44 (defclass view-mode (mode)
45 ()
46 (:documentation "The superclass for all view modes."))
47
48 (defclass syntax-mode (mode)
49 ()
50 (:documentation "The superclass for all syntax modes."))
51
52 (defmacro define-mode (name (&rest superclasses)
53 (&rest slot-specs)
54 &rest options)
55 "Define a toggable Drei mode. It is essentially a class, with
56 the provided `name', `superclasses', `slot-specs' and
57 `options'. It will automatically be a subclass of `mode'. Apart
58 from the normal class options, `options' can also have a
59 `:global' option, which when true signifies that the mode is
60 globally available to all Drei instances. This option is true by
61 default. Note that modes created via this macro are not
62 applicable to anything."
63 (let ((global t)
64 (actual-options '()))
65 (dolist (option options)
66 (case (first option)
67 (:global (setf global (second option)))
68 (t (push option actual-options))))
69 `(progn
70 (defclass ,name (,@superclasses mode)
71 (,@slot-specs)
72 ,@actual-options)
73 ,(when global `(push ',name *global-modes*)))))
74
75 (defmacro define-view-mode (name (&rest superclasses)
76 (&rest slot-specs)
77 &rest options)
78 "Define a mode (as `define-mode') that is applicable to
79 views. Apart from taking the same options as `define-mode', it
80 also takes an `:applicable-views' option (nil by default) that is
81 a list of views the mode should be applicable to. Multiple uses
82 of this option are cumulative."
83 (let ((applicable-views '())
84 (actual-options '()))
85 (dolist (option options)
86 (case (first option)
87 (:applicable-views (setf applicable-views
88 (append applicable-views
89 (rest option))))
90 (t (push option actual-options))))
91 `(progn
92 (define-mode ,name (,@superclasses view-mode)
93 (,@slot-specs)
94 ,@actual-options)
95 ,@(loop for view in applicable-views
96 collecting `(defmethod mode-directly-applicable-p or
97 ((view ,view) (mode-name (eql ',name)))
98 t)))))
99
100 (defmacro define-syntax-mode (name (&rest superclasses)
101 (&rest slot-specs)
102 &rest options)
103 "Define a mode (as `define-mode') that is applicable to
104 syntaxes. Apart from taking the same options as `define-mode', it
105 also takes an `:applicable-syntaxes' option (nil by default) that
106 is a list of syntaxes the mode should be applicable to. Multiple
107 uses of this option are cumulative."
108 (let ((applicable-syntaxes '())
109 (actual-options '()))
110 (dolist (option options)
111 (case (first option)
112 (:applicable-syntaxes (setf applicable-syntaxes
113 (append applicable-syntaxes
114 (rest option))))
115 (t (push option actual-options))))
116 `(progn
117 (define-mode ,name (,@superclasses syntax-mode)
118 (,@slot-specs)
119 ,@actual-options)
120 ,@(loop for syntax in applicable-syntaxes
121 collecting `(defmethod mode-directly-applicable-p or
122 ((syntax ,syntax) (mode-name (eql ',name)))
123 t)))))
124
125 (defmacro define-mode-toggle-commands (command-name
126 (mode-name &optional (string-form (capitalize (string mode-name))))
127 &key (name t) command-table)
128 "Define a simple command (named `command-name') for toggling
129 the mode named by `mode-name' on and off. `String-form' is the
130 name of the mode that will be put in the docstring, `name' and
131 `command-table' work as in `define-command'."
132 (check-type command-name symbol)
133 (check-type mode-name symbol)
134 (check-type string-form string)
135 `(define-command (,command-name :name ,name :command-table ,command-table)
136 ()
137 ,(concatenate 'string "Toggle " string-form " mode.")
c088abf Changed *drei-instance* to be a function (drei-instance).
Troels Henriksen authored
138 (if (mode-enabled-p (drei-instance) ',mode-name)
139 (disable-mode (drei-instance) ',mode-name)
140 (enable-mode (drei-instance) ',mode-name))))
Something went wrong with that request. Please try again.