|
0
|
1 ;;;; psgml-other.el --- Part of SGML-editing mode with parsing support
|
|
|
2 ;; $Id: psgml-other.el,v 1.1.1.1 1996/12/18 03:35:21 steve Exp $
|
|
|
3
|
|
|
4 ;; Copyright (C) 1994 Lennart Staflin
|
|
|
5
|
|
|
6 ;; Author: Lennart Staflin <lenst@lysator.liu.se>
|
|
|
7
|
|
|
8 ;;
|
|
|
9 ;; This program is free software; you can redistribute it and/or
|
|
|
10 ;; modify it under the terms of the GNU General Public License
|
|
|
11 ;; as published by the Free Software Foundation; either version 2
|
|
|
12 ;; of the License, or (at your option) any later version.
|
|
|
13 ;;
|
|
|
14 ;; This program is distributed in the hope that it will be useful,
|
|
|
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;; GNU General Public License for more details.
|
|
|
18 ;;
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with this program; if not, write to the Free Software
|
|
|
21 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
22
|
|
|
23
|
|
|
24 ;;;; Commentary:
|
|
|
25
|
|
|
26 ;;; Part of psgml.el
|
|
|
27
|
|
|
28 ;;; Menus for use with FSF Emacs 19
|
|
|
29
|
|
|
30
|
|
|
31 ;;;; Code:
|
|
|
32
|
|
|
33 (require 'psgml)
|
|
|
34 (require 'easymenu)
|
|
|
35
|
|
|
36 (defvar sgml-max-menu-size (/ (* (frame-height) 2) 3)
|
|
|
37 "*Max number of entries in Tags and Entities menus before they are split
|
|
|
38 into several panes.")
|
|
|
39
|
|
|
40
|
|
|
41 ;;;; Menu bar
|
|
|
42
|
|
|
43 (easy-menu-define
|
|
|
44 sgml-dtd-menu sgml-mode-map "DTD menu"
|
|
|
45 '("DTD"))
|
|
|
46
|
|
|
47 (defconst sgml-dtd-root-menu
|
|
|
48 '("DTD"
|
|
|
49 ["Parse DTD" sgml-parse-prolog t]
|
|
|
50 ("Info"
|
|
|
51 ["General DTD info" sgml-general-dtd-info t]
|
|
|
52 ["Describe element type" sgml-describe-element-type t]
|
|
|
53 ["Describe entity" sgml-describe-entity t]
|
|
|
54 ["List elements" sgml-list-elements t]
|
|
|
55 ["List attributes" sgml-list-attributes t]
|
|
|
56 ["List terminals" sgml-list-terminals t]
|
|
|
57 ["List content elements" sgml-list-content-elements t]
|
|
|
58 ["List occur in elements" sgml-list-occur-in-elements t]
|
|
|
59 )
|
|
|
60 "--"
|
|
|
61 ["Load Parsed DTD" sgml-load-dtd t]
|
|
|
62 ["Save Parsed DTD" sgml-save-dtd t]
|
|
|
63 ))
|
|
|
64
|
|
|
65 (easy-menu-define
|
|
|
66 sgml-view-menu sgml-mode-map "View menu"
|
|
|
67 '("View"
|
|
|
68 ["Fold Element" sgml-fold-element t]
|
|
|
69 ["Fold Subelement" sgml-fold-subelement t]
|
|
|
70 ["Unfold Line" sgml-unfold-line t]
|
|
|
71 ["Unfold Element" sgml-unfold-element t]
|
|
|
72 ["Expand" sgml-expand-element t]
|
|
|
73 ["Fold Region" sgml-fold-region t]
|
|
|
74 ["Unfold All" sgml-unfold-all t]
|
|
|
75 ["Hide Tags" sgml-hide-tags t]
|
|
|
76 ["Hide Attributes" sgml-hide-attributes t]
|
|
|
77 ["Show All Tags" sgml-show-tags t]
|
|
|
78 )
|
|
|
79 )
|
|
|
80
|
|
|
81
|
|
|
82 (easy-menu-define
|
|
|
83 sgml-markup-menu sgml-mode-map "Markup menu"
|
|
|
84 '("Markup")
|
|
|
85 )
|
|
|
86
|
|
|
87 (defconst sgml-markup-root-menu
|
|
|
88 '("Markup"
|
|
|
89 ["Insert Element" sgml-element-menu t]
|
|
|
90 ["Insert Start-Tag" sgml-start-tag-menu t]
|
|
|
91 ["Insert End-Tag" sgml-end-tag-menu t]
|
|
|
92 ["Tag Region" sgml-tag-region-menu t]
|
|
|
93 ["Insert Attribute" sgml-attrib-menu t]
|
|
|
94 ["Insert Entity" sgml-entities-menu t]
|
|
|
95 ))
|
|
|
96
|
|
|
97 (easy-menu-define
|
|
|
98 sgml-move-menu sgml-mode-map "Menu of move commands"
|
|
|
99 '("Move"
|
|
|
100 ["Next trouble spot" sgml-next-trouble-spot t]
|
|
|
101 ["Next data field" sgml-next-data-field t]
|
|
|
102 ["Forward element" sgml-forward-element t]
|
|
|
103 ["Backward element" sgml-backward-element t]
|
|
|
104 ["Up element" sgml-up-element t]
|
|
|
105 ["Down element" sgml-down-element t]
|
|
|
106 ["Backward up element" sgml-backward-up-element t]
|
|
|
107 ["Beginning of element" sgml-beginning-of-element t]
|
|
|
108 ["End of element" sgml-end-of-element t]
|
|
|
109 ))
|
|
|
110
|
|
|
111 (easy-menu-define
|
|
|
112 sgml-modify-menu sgml-mode-map "Menu of modification commands"
|
|
|
113 '("Modify"
|
|
|
114 ["Normalize" sgml-normalize t]
|
|
|
115 ["Expand All Short References" sgml-expand-all-shortrefs t]
|
|
|
116 ["Expand Entity Reference" sgml-expand-entity-reference t]
|
|
|
117 ["Normalize Element" sgml-normalize-element t]
|
|
|
118 ["Make Character Reference" sgml-make-character-reference t]
|
|
|
119 ["Unmake Character Reference" (sgml-make-character-reference t) t]
|
|
|
120 ["Fill Element" sgml-fill-element t]
|
|
|
121 ["Change Element Name..." sgml-change-element-name t]
|
|
|
122 ["Edit Attributes..." sgml-edit-attributes t]
|
|
|
123 ["Kill Markup" sgml-kill-markup t]
|
|
|
124 ["Kill Element" sgml-kill-element t]
|
|
|
125 ["Untag Element" sgml-untag-element t]
|
|
|
126 ["Trim and leave element" sgml-trim-and-leave-element t]
|
|
|
127 ["Decode Character Entities" sgml-charent-to-display-char t]
|
|
|
128 ["Encode Characters" sgml-display-char-to-charent t]
|
|
|
129 )
|
|
|
130 )
|
|
|
131
|
|
|
132 (easy-menu-define
|
|
|
133 sgml-main-menu sgml-mode-map "Main menu"
|
|
|
134 '("SGML"
|
|
|
135 ["Reset Buffer" normal-mode t]
|
|
|
136 ["End Element" sgml-insert-end-tag t]
|
|
|
137 ["Show Context" sgml-show-context t]
|
|
|
138 ["What Element" sgml-what-element t]
|
|
|
139 ["List Valid Tags" sgml-list-valid-tags t]
|
|
|
140 ["Show/Hide Warning Log" sgml-show-or-clear-log t]
|
|
|
141 ["Validate" sgml-validate t]
|
|
|
142 ["File Options >" sgml-file-options-menu t]
|
|
|
143 ["User Options >" sgml-user-options-menu t]
|
|
|
144 ["Save File Options" sgml-save-options t]
|
|
|
145 ["Submit Bug Report" sgml-submit-bug-report t]
|
|
|
146 )
|
|
|
147 )
|
|
|
148
|
|
|
149
|
|
|
150 ;;;; Key Commands
|
|
|
151
|
|
|
152 ;; Doesn't this work in Lucid? ***
|
|
|
153 (define-key sgml-mode-map [?\M-\C-\ ] 'sgml-mark-element)
|
|
|
154
|
|
|
155 (define-key sgml-mode-map [S-mouse-1] 'sgml-tags-menu)
|
|
|
156
|
|
|
157
|
|
|
158 ;;;; Pop Up Menus
|
|
|
159
|
|
|
160 (defun sgml-popup-menu (event title entries)
|
|
|
161 "Display a popup menu.
|
|
|
162 ENTRIES is a list where every element has the form (STRING . VALUE) or
|
|
|
163 STRING."
|
|
|
164 (x-popup-menu
|
|
|
165 event
|
|
|
166 (let ((menus (list (cons title entries))))
|
|
|
167 (cond ((> (length entries)
|
|
|
168 sgml-max-menu-size)
|
|
|
169 (setq menus
|
|
|
170 (loop for i from 1 while entries
|
|
|
171 collect
|
|
|
172 (let ((submenu
|
|
|
173 (subseq entries 0 (min (length entries)
|
|
|
174 sgml-max-menu-size))))
|
|
|
175 (setq entries (nthcdr sgml-max-menu-size
|
|
|
176 entries))
|
|
|
177 (cons
|
|
|
178 (format "%s '%s'-'%s'"
|
|
|
179 title
|
|
|
180 (sgml-range-indicator (caar submenu))
|
|
|
181 (sgml-range-indicator (caar (last submenu))))
|
|
|
182 submenu))))))
|
|
|
183 (cons title menus))))
|
|
|
184
|
|
|
185 (defun sgml-range-indicator (string)
|
|
|
186 (substring string
|
|
|
187 0
|
|
|
188 (min (length string) sgml-range-indicator-max-length)))
|
|
|
189
|
|
|
190 (defun sgml-popup-multi-menu (event title menus)
|
|
|
191 "Display a popup menu.
|
|
|
192 MENUS is a list of menus on the form (TITLE ITEM1 ITEM2 ...).
|
|
|
193 ITEM should have to form (STRING EXPR) or STRING. The EXPR gets evaluated
|
|
|
194 if the item is selected."
|
|
|
195 (nconc menus '(("---" "---"))) ; Force x-popup-menu to use two level
|
|
|
196 ; menu even if there is only one entry
|
|
|
197 ; on the first level
|
|
|
198 (eval (car (x-popup-menu event (cons title menus)))))
|
|
|
199
|
|
|
200
|
|
|
201
|
|
|
202 ;;;; Build Custom Menus
|
|
|
203
|
|
|
204 (defun sgml-build-custom-menus ()
|
|
|
205 ;; Build custom menus
|
|
|
206 ;; (sgml-add-custom-entries
|
|
|
207 ;; sgml-markup-menu
|
|
|
208 ;; (mapcar (function (lambda (e)
|
|
|
209 ;; (sgml-markup (car e) (cadr e))))
|
|
|
210 ;; sgml-custom-markup))
|
|
|
211 (easy-menu-define
|
|
|
212 sgml-markup-menu sgml-mode-map "Markup menu"
|
|
|
213 (append sgml-markup-root-menu
|
|
|
214 (list "----")
|
|
|
215 (loop for e in sgml-custom-markup collect
|
|
|
216 (vector (first e)
|
|
|
217 (` (sgml-insert-markup (, (cadr e))))
|
|
|
218 t))))
|
|
|
219 (easy-menu-define
|
|
|
220 sgml-dtd-menu sgml-mode-map "DTD menu"
|
|
|
221 (append sgml-dtd-root-menu
|
|
|
222 (list "----")
|
|
|
223 (loop for e in sgml-custom-dtd collect
|
|
|
224 (vector (first e)
|
|
|
225 (` (sgml-doctype-insert (, (cadr e))
|
|
|
226 '(, (cddr e))))
|
|
|
227 t)))))
|
|
|
228
|
|
|
229
|
|
|
230 ;(defun sgml-add-custom-entries (keymap entries)
|
|
|
231 ; "Add to KEYMAP the ENTRIES, a list of (name . command) pairs.
|
|
|
232 ;The entries are added last in keymap and a blank line precede it."
|
|
|
233 ; (let ((l keymap)
|
|
|
234 ; (last (last keymap))) ; cons with keymap name
|
|
|
235 ; ;; Find the cons before 'blank-c' event, or last cons.
|
|
|
236 ; (while (and (cdr l)
|
|
|
237 ; (consp (cadr l))
|
|
|
238 ; (not (eq 'blank-c (caadr l))))
|
|
|
239 ; (setq l (cdr l)))
|
|
|
240 ; ;; Delete entries after
|
|
|
241 ; (setcdr l nil)
|
|
|
242 ; (when entries ; now add the entries
|
|
|
243 ; (setcdr l
|
|
|
244 ; (cons
|
|
|
245 ; '(blank-c "") ; a blank line before custom entries
|
|
|
246 ; (loop for i from 0 as e in entries
|
|
|
247 ; collect (cons (intern (concat "custom" i)) e)))))
|
|
|
248 ; ;; add keymap name to keymap
|
|
|
249 ; (setcdr (last keymap) last)))
|
|
|
250
|
|
|
251
|
|
|
252
|
|
|
253
|
|
|
254
|
|
|
255
|
|
|
256 ;;;; Insert with properties
|
|
|
257
|
|
|
258 (defvar sgml-write-protect-intagible
|
|
|
259 (not (boundp 'emacs-minor-version)))
|
|
|
260
|
|
|
261 (defun sgml-insert (props format &rest args)
|
|
|
262 (let ((start (point)))
|
|
|
263 (insert (apply (function format)
|
|
|
264 format
|
|
|
265 args))
|
|
|
266 (when (and sgml-write-protect-intagible
|
|
|
267 (getf props 'intangible))
|
|
|
268 (setf (getf props 'read-only) t))
|
|
|
269 (add-text-properties start (point) props)))
|
|
|
270
|
|
|
271
|
|
|
272 ;;;; Set face of markup
|
|
|
273
|
|
|
274 (defun sgml-set-face-for (start end type)
|
|
|
275 (let ((current (overlays-at start))
|
|
|
276 (face (cdr (assq type sgml-markup-faces)))
|
|
|
277 (pos start)
|
|
|
278 o)
|
|
|
279 (while current
|
|
|
280 (cond ((and (null o)
|
|
|
281 (eq type (overlay-get (car current) 'sgml-type)))
|
|
|
282 (setq o (car current)))
|
|
|
283 ((overlay-get (car current) 'sgml-type)
|
|
|
284 (delete-overlay (car current))))
|
|
|
285 (setq current (cdr current)))
|
|
|
286 (while (< (setq pos (next-overlay-change pos))
|
|
|
287 end)
|
|
|
288 (setq current (overlays-at pos))
|
|
|
289 (while current
|
|
|
290 (when (overlay-get (car current) 'sgml-type)
|
|
|
291 (delete-overlay (car current)))
|
|
|
292 (setq current (cdr current))))
|
|
|
293 (cond (o
|
|
|
294 (move-overlay o start end)
|
|
|
295 (if (null (overlay-get o 'face))
|
|
|
296 (overlay-put o 'face face)))
|
|
|
297 (face
|
|
|
298 (setq o (make-overlay start end))
|
|
|
299 (overlay-put o 'sgml-type type)
|
|
|
300 (overlay-put o 'face face)))))
|
|
|
301
|
|
|
302 (defun sgml-set-face-after-change (start end &optional pre-len)
|
|
|
303 (when sgml-set-face
|
|
|
304 (loop for o in (overlays-at start)
|
|
|
305 do (cond
|
|
|
306 ((not (overlay-get o 'sgml-type)))
|
|
|
307 ((= start (overlay-start o))
|
|
|
308 (move-overlay o end (overlay-end o)))))))
|
|
|
309
|
|
|
310 (defalias 'next-overlay-at 'next-overlay-change) ; fix bug in cl.el
|
|
|
311
|
|
|
312 (defun sgml-clear-faces ()
|
|
|
313 (interactive)
|
|
|
314 (loop for o being the overlays
|
|
|
315 if (overlay-get o 'sgml-type)
|
|
|
316 do (delete-overlay o)))
|
|
|
317
|
|
|
318
|
|
|
319 ;;;; Provide
|
|
|
320
|
|
|
321 (provide 'psgml-other)
|
|
|
322
|
|
|
323 ;;; psgml-other.el ends here
|
