aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1993-11-08 14:46:50 +0000
committerRichard M. Stallman1993-11-08 14:46:50 +0000
commit1a2b6c5271dcd5276501d104700682f752235e9b (patch)
tree7c72b5f88b7913c16a58249521efd3a4c281552b
parent794572af7060d1482178b75aef62a5bd0be19c35 (diff)
downloademacs-1a2b6c5271dcd5276501d104700682f752235e9b.tar.gz
emacs-1a2b6c5271dcd5276501d104700682f752235e9b.zip
Initial revision
-rw-r--r--lisp/mouse-sel.el437
-rw-r--r--lisp/progmodes/pascal.el980
-rw-r--r--lisp/thingatpt.el206
3 files changed, 1623 insertions, 0 deletions
diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el
new file mode 100644
index 00000000000..d4467a0e997
--- /dev/null
+++ b/lisp/mouse-sel.el
@@ -0,0 +1,437 @@
1;;; mouse-sel.el --- Multi-click selection support for Emacs 19
2
3;; Copyright (C) 1993 Free Software Foundation, Inc.
4
5;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
6;; Keywords: mouse
7;; Version: $Revision: 1.20 $
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;;; Commentary:
22;;
23;; This module provides multi-click mouse support for GNU Emacs versions
24;; 19.18 and later. I've tried to make it behave more like standard X
25;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
26;; Basically:
27;;
28;; * Clicking mouse-1 starts (cancels) selection, dragging extends it.
29;;
30;; * Clicking or dragging mouse-3 extends the selection as well.
31;;
32;; * Double-clicking on word constituents selects words.
33;; Double-clicking on symbol constituents selects symbols.
34;; Double-clicking on quotes or parentheses selects sexps.
35;; Double-clicking on whitespace selects whitespace.
36;; Triple-clicking selects lines.
37;;
38;; * Selecting sets the region & X primary selection, but does NOT affect
39;; the kill-ring. Because the mouse handlers set the primary selection
40;; directly, mouse-sel sets the variables interprogram-cut-function
41;; and interprogram-paste-function to nil.
42;;
43;; * Clicking mouse-2 pastes contents of primary selection.
44;;
45;; * Pressing mouse-2 while selecting or extending copies selected text
46;; to the kill ring. Pressing mouse-1 or mouse-3 kills it.
47;;
48;; This module requires my thingatpt.el module, version 1.14 or later, which
49;; it uses to find the bounds of words, lines, sexps, etc.
50;;
51;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
52;;
53;; You may also want to use one or more of following:
54;;
55;; ;; Enable region highlight
56;; (transient-mark-mode 1)
57;;
58;; ;; But only in the selected window
59;; (setq highlight-nonselected-windows nil)
60;;
61;; ;; Enable pending-delete
62;; (delete-selection-mode 1)
63;;
64;;--- Customisation -------------------------------------------------------
65;;
66;; * You can control the way mouse-sel binds it's keys by setting the value
67;; of mouse-sel-default-bindings before loading mouse-sel.
68;;
69;; (a) If mouse-sel-default-bindings = t (the default)
70;;
71;; Mouse sets and pastes selection
72;; mouse-1 mouse-select
73;; mouse-2 mouse-insert-selection
74;; mouse-3 mouse-extend
75;;
76;; Selection/kill-ring interaction is disabled
77;; interprogram-cut-function = nil
78;; interprogram-paste-function = nil
79;;
80;; (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
81;;
82;; Mouse sets selection, and pastes from kill-ring
83;; mouse-1 mouse-select
84;; mouse-2 mouse-yank-at-click
85;; mouse-3 mouse-extend
86;;
87;; Selection/kill-ring interaction is retained
88;; interprogram-cut-function = x-select-text
89;; interprogram-paste-function = x-cut-buffer-or-selection-value
90;;
91;; What you lose is the ability to select some text in
92;; delete-selection-mode and yank over the top of it.
93;;
94;; (c) If mouse-sel-default-bindings = nil, no bindings are made.
95;;
96;; * I like to leave point at the end of the region nearest to where the
97;; mouse was, even though this makes region highlighting mis-leading (the
98;; cursor makes it look like one extra character is selected). You can
99;; disable this behaviour with:
100;;
101;; (setq mouse-sel-leave-point-near-mouse nil)
102;;
103;; * Normally, the selection highlight will be removed when the mouse is
104;; lifted. You can tell mouse-sel to retain the selection highlight
105;; (useful if you don't use transient-mark-mode) with:
106;;
107;; (setq mouse-sel-retain-highlight t)
108;;
109;; * By default, mouse-select cycles the click count after 3 clicks. That
110;; is, clicking mouse-1 four times has the same effect as clicking it
111;; once, clicking five times has the same effect as clicking twice, etc.
112;; Disable this behaviour with:
113;;
114;; (setq mouse-sel-cycle-clicks nil)
115;;
116;; * The variables mouse-sel-{set,get,check}-selection-function control how
117;; the selection is handled. Under X Windows, these variables default so
118;; that the X primary selection is used. Under other windowing systems,
119;; alternate functions are used, which simply store the selection value
120;; in a variable.
121;;
122;;--- Hints ---------------------------------------------------------------
123;;
124;; * You can change the selection highlight face by altering the properties
125;; of mouse-drag-overlay, eg.
126;;
127;; (overlay-put mouse-drag-overlay 'face 'bold)
128;;
129;; * Pasting from the primary selection under emacs 19.19 is SLOW (there's
130;; a two second delay). The following code will cause mouse-sel to use
131;; the cut buffer rather than the primary selection. However, be aware
132;; that cut buffers are OBSOLETE, and some X applications may not support
133;; them.
134;;
135;; (setq mouse-sel-set-selection-function 'x-select-text
136;; mouse-sel-get-selection-function 'x-get-cut-buffer)
137;;
138;;--- Warnings ------------------------------------------------------------
139;;
140;; * When selecting sexps, the selection extends by sexps at the same
141;; nesting level. This also means the selection cannot be extended out
142;; of the enclosing nesting level. This is INTENTIONAL.
143
144;;; Code:
145
146(provide 'mouse-sel)
147
148(require 'mouse)
149(require 'thingatpt)
150
151;;=== Version =============================================================
152
153(defconst mouse-sel-version (substring "$Revision: 1.20 $" 11 -2)
154 "The revision number of mouse-sel (as string). The complete RCS id is:
155
156 $Id: mouse-sel.el,v 1.20 1993/09/30 23:57:32 mike Exp $")
157
158;;=== User Variables ======================================================
159
160(defvar mouse-sel-leave-point-near-mouse t
161 "*Leave point near last mouse position.
162If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
163of the region nearest to where the mouse last was.
164If nil, point will always be placed at the beginning of the region.")
165
166(defvar mouse-sel-retain-highlight nil
167 "*Retain highlight on mouse-drag-overlay.
168If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will
169remain highlighted.
170If nil, highlighting will be turned off when the mouse is lifted.")
171
172(defvar mouse-sel-cycle-clicks t
173 "*If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks.
174Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc.")
175
176(defvar mouse-sel-default-bindings t
177 "Set to nil before loading mouse-sel to prevent default mouse bindings.")
178
179;;=== Selection ===========================================================
180
181(defvar mouse-sel-selection-type nil "Type of current selection")
182(make-variable-buffer-local 'mouse-sel-selection-type)
183
184(defvar mouse-sel-selection ""
185 "This variable is used to store the selection value when mouse-sel is
186used on windowing systems other than X Windows.")
187
188(defvar mouse-sel-set-selection-function
189 (if (eq window-system 'x)
190 (function (lambda (s) (x-set-selection 'PRIMARY s)))
191 (function (lambda (s) (setq mouse-sel-selection s))))
192 "Function to call to set selection.
193Called with one argument, the text to select.")
194
195(defvar mouse-sel-get-selection-function
196 (if (eq window-system 'x)
197 'x-get-selection
198 (function (lambda () mouse-sel-selection)))
199 "Function to call to get the selection.
200Called with no argument, it should return the selected text.")
201
202(defvar mouse-sel-check-selection-function
203 (if (eq window-system 'x)
204 'x-selection-owner-p
205 nil)
206 "Function to check whether emacs still owns the selection.
207Called with no arguments.")
208
209(defun mouse-sel-determine-selection-type (NCLICKS)
210 "Determine what `thing' \\[mouse-select] and \\[mouse-extend] should
211select by. The first argument is NCLICKS, is the number of consecutive
212mouse clicks at the same position."
213 (let* ((next-char (char-after (point)))
214 (char-syntax (if next-char (char-syntax next-char)))
215 (nclicks (if mouse-sel-cycle-clicks (1+ (% (1- NCLICKS) 3)) NCLICKS)))
216 (cond
217 ((= nclicks 1) nil)
218 ((>= nclicks 3) 'line)
219 ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
220 ((memq next-char '(? ?\t ?\n)) 'whitespace)
221 ((eq char-syntax ?_) 'symbol)
222 ((eq char-syntax ?w) 'word))))
223
224(defun mouse-select (EVENT)
225 "Set region/selection using the mouse.
226
227On click, point & mark are set to click position, and mark is disabled.
228Dragging extends region/selection.
229
230Double-clicking on word constituents selects words.
231Double-clicking on symbol constituents selects symbols.
232Double-clicking on quotes or parentheses selects sexps.
233Double-clicking on whitespace selects whitespace.
234Triple-clicking selects lines.
235
236Clicking mouse-2 while selecting copies the region to the kill-ring.
237Clicking mouse-1 or mouse-3 kills the region.
238
239This should be bound to a down-mouse event."
240 (interactive "e")
241 (mouse-set-point EVENT)
242 (setq mouse-sel-selection-type
243 (mouse-sel-determine-selection-type (event-click-count EVENT)))
244 (let ((object-bounds (bounds-of-thing-at-point mouse-sel-selection-type)))
245 (if object-bounds
246 (progn
247 (setq mark-active t)
248 (goto-char (car object-bounds))
249 (set-mark (cdr object-bounds)))
250 (deactivate-mark)))
251 (mouse-extend))
252
253(defun mouse-extend (&optional EVENT)
254 "Extend region/selection using the mouse.
255
256See documentation for mouse-select for more details.
257
258This should be bound to a down-mouse event."
259 (interactive "e")
260 (if EVENT (select-window (posn-window (event-end EVENT))))
261 (let* ((min (if mark-active (region-beginning) (point)))
262 (max (if mark-active (region-end) (point)))
263 (orig-window (selected-window))
264 (orig-window-frame (window-frame orig-window))
265 (top (nth 1 (window-edges orig-window)))
266 (bottom (nth 3 (window-edges orig-window)))
267 (orig-cursor-type
268 (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))
269 direction
270 event)
271
272 ;; Inhibit normal region highlight
273 (setq mark-active nil)
274
275 ;; Highlight region (forcing re-highlight)
276 (move-overlay mouse-drag-overlay min max (current-buffer))
277 (overlay-put mouse-drag-overlay 'face
278 (overlay-get mouse-drag-overlay 'face))
279
280 ;; Bar cursor
281 (modify-frame-parameters (selected-frame) '((cursor-type . bar)))
282
283 ;; Handle dragging
284 (unwind-protect
285 (progn
286 (track-mouse
287
288 (while (if EVENT ; Use initial event
289 (prog1
290 (setq event EVENT)
291 (setq EVENT nil))
292 (setq event (read-event))
293 (and (consp event)
294 (memq (car event) '(mouse-movement switch-frame))))
295
296 (let ((end (event-end event)))
297
298 (cond
299
300 ;; Ignore any movement outside the frame
301 ((eq (car-safe event) 'switch-frame) nil)
302 ((and (posn-window end)
303 (not (eq (window-frame (posn-window end))
304 (window-frame orig-window)))) nil)
305
306 ;; Different window, same frame
307 ((not (eq (posn-window end) orig-window))
308 (let ((end-row (cdr (cdr (mouse-position)))))
309 (cond
310 ((and end-row (not (bobp)) (< end-row top))
311 (mouse-scroll-subr (- end-row top)
312 mouse-drag-overlay max))
313 ((and end-row (not (eobp)) (>= end-row bottom))
314 (mouse-scroll-subr (1+ (- end-row bottom))
315 mouse-drag-overlay min))
316 )))
317
318 ;; On the mode line
319 ((eq (posn-point end) 'mode-line)
320 (mouse-scroll-subr 1 mouse-drag-overlay min))
321
322 ;; In original window
323 (t (goto-char (posn-point end)))
324
325 )
326
327 ;; Determine direction of drag
328 (cond
329 ((and (not direction) (not (eq min max)))
330 (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
331 ((and (not (eq direction -1)) (<= (point) min))
332 (setq direction -1))
333 ((and (not (eq direction 1)) (>= (point) max))
334 (setq direction 1)))
335
336 (if (not mouse-sel-selection-type) nil
337
338 ;; If dragging forward, goal is next character
339 (if (and (eq direction 1) (not (eobp))) (forward-char 1))
340
341 ;; Move to start/end of selected thing
342 (let ((goal (point))
343 last)
344 (goto-char (if (eq 1 direction) min max))
345 (condition-case nil
346 (progn
347 (while (> (* direction (- goal (point))) 0)
348 (setq last (point))
349 (forward-thing mouse-sel-selection-type
350 direction))
351 (let ((end (point)))
352 (forward-thing mouse-sel-selection-type
353 (- direction))
354 (goto-char
355 (if (> (* direction (- goal (point))) 0)
356 end last))))
357 (error))))
358
359 ;; Move overlay
360 (move-overlay mouse-drag-overlay
361 (if (eq 1 direction) min (point))
362 (if (eq -1 direction) max (point))
363 (current-buffer))
364
365 ))) ; end track-mouse
366
367 (let ((overlay-start (overlay-start mouse-drag-overlay))
368 (overlay-end (overlay-end mouse-drag-overlay)))
369
370 ;; Set region
371 (if (eq overlay-start overlay-end)
372 (deactivate-mark)
373 (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
374 (progn
375 (set-mark overlay-start)
376 (goto-char overlay-end))
377 (set-mark overlay-end)
378 (goto-char overlay-start)))
379
380 ;; Set selection
381 (if (and mark-active mouse-sel-set-selection-function)
382 (funcall mouse-sel-set-selection-function
383 (buffer-substring overlay-start overlay-end)))
384
385 ;; Handle copy/kill
386 (cond
387 ((eq (car-safe last-input-event) 'down-mouse-2)
388 (copy-region-as-kill overlay-start overlay-end)
389 (read-event) (read-event))
390 ((memq (car-safe last-input-event) '(down-mouse-1 down-mouse-3))
391 (kill-region overlay-start overlay-end)
392 (deactivate-mark)
393 (read-event) (read-event)))))
394
395 ;; Restore cursor
396 (modify-frame-parameters (selected-frame)
397 (list (cons 'cursor-type orig-cursor-type)))
398 ;; Remove overlay
399 (or mouse-sel-retain-highlight
400 (delete-overlay mouse-drag-overlay)))))
401
402(defun mouse-insert-selection (click)
403 "Insert the contents of the selection at mouse click."
404 (interactive "e")
405 (mouse-set-point click)
406 (deactivate-mark)
407 (if mouse-sel-get-selection-function
408 (insert (or (funcall mouse-sel-get-selection-function) ""))))
409
410(defun mouse-sel-validate-selection ()
411 "Remove selection highlight if emacs no longer owns the primary selection."
412 (or (not mouse-sel-check-selection-function)
413 (funcall mouse-sel-check-selection-function)
414 (delete-overlay mouse-drag-overlay)))
415
416(add-hook 'pre-command-hook 'mouse-sel-validate-selection)
417
418;;=== Key bindings ========================================================
419
420(if (not mouse-sel-default-bindings) nil
421
422 (global-unset-key [mouse-1])
423 (global-unset-key [drag-mouse-1])
424 (global-unset-key [mouse-3])
425
426 (global-set-key [down-mouse-1] 'mouse-select)
427 (global-set-key [down-mouse-3] 'mouse-extend)
428
429 (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
430
431 (global-set-key [mouse-2] 'mouse-insert-selection)
432 (setq interprogram-cut-function nil
433 interprogram-paste-function nil))
434
435 )
436
437;; mouse-sel.el ends here.
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
new file mode 100644
index 00000000000..cf5d2589029
--- /dev/null
+++ b/lisp/progmodes/pascal.el
@@ -0,0 +1,980 @@
1;;; pascal.el - Major mode for editing pascal source in emacs.
2
3;;; Copyright (C) 1993 Free Software Foundation, Inc.
4
5;; Author: Espen Skoglund (espensk@stud.cs.uit.no)
6;; Keywords: languages
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to
22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24;;; Commentary:
25
26;;; If you want to customize the pascal mode in your startup file, you
27;;; can add these lines to your .emacs file (and remove the ;s at the
28;;; beginning of the line):
29;;;
30;;; ;;; Pascal-mode custumization.
31;;; (autoload 'pascal-mode "pascal-mode" nil t)
32;;; (setq auto-mode-alist (append (list (cons "\\.p$" 'pascal-mode)
33;;; (cons "\\.pas$" 'pascal-mode))
34;;; auto-mode-alist))
35;;; (setq pascal-mode-hook '(lambda ()
36;;; ;; User specifications
37;;; (setq pascal-tab-always-indent t
38;;; pascal-auto-newline nil
39;;; pascal-auto-endcomments t
40;;; pascal-indent-level 3
41;;; pascal-continued-expr 1
42;;; pascal-label-offset -2
43;;; pascal-case-offset 2
44;;; pascal-typedecl-indent 10
45;;; pascal-vardecl-indent 20)))
46
47;;; USAGE
48;;; =====
49;;; If you have modified your startup file as described above, emacs
50;;; should enter pascal-mode when you load a pascal source into emacs.
51;;; If not, you will have to start pascal-mode manually:
52;;; M-x load-library pascal-mode
53;;; M-x pascal-mode
54;;; When you have entered pascal-mode, you may get more info by pressing
55;;; C-h m. You may also get online help describing various functions by:
56;;; C-h d <Name of function you want described>
57
58;;; KNOWN BUGS / BUGREPORTS
59;;; =======================
60;;; As far as I know, there are no bugs in the current version of this
61;;; package. This may not be true however, since I never use this mode
62;;; myself and therefore would never notice them anyway. But if you DO
63;;; find any bugd, you may submitt them to: espensk@stud.cs.uit.no
64
65;;; LCD Archive Entry:
66;;; pascal-mode|Espen Skoglund|espensk@stud.cs.uit.no|
67;;; Major mode for editing Pascal code|
68;;; 14-Sep-93|$Revision: 1.3 $|~/modes/pascal-mode.el.Z|
69
70(defconst pascal-mode-version "1.3"
71 "Version of this pascal mode.")
72
73(defvar pascal-mode-abbrev-table nil
74 "Abbrev table in use in Pascal-mode buffers.")
75(define-abbrev-table 'pascal-mode-abbrev-table ())
76
77(defvar pascal-mode-map ()
78 "Keymap used in Pascal mode.")
79(if (null pascal-mode-map)
80 (setq pascal-mode-map (make-sparse-keymap)))
81
82(define-key pascal-mode-map ";" 'electric-pascal-semi)
83(define-key pascal-mode-map "." 'electric-pascal-dot)
84(define-key pascal-mode-map ":" 'electric-pascal-colon)
85(define-key pascal-mode-map "=" 'electric-pascal-equal)
86(define-key pascal-mode-map "\r" 'electric-pascal-terminate-line)
87(define-key pascal-mode-map "\t" 'electric-pascal-tab)
88(define-key pascal-mode-map "\177" 'backward-delete-char-untabify)
89(define-key pascal-mode-map "\C-\M-a" 'pascal-backward-to-beginning-of-function)
90(define-key pascal-mode-map "\C-\M-e" 'pascal-forward-to-end-of-function)
91(define-key pascal-mode-map "\C-\M-h" 'pascal-mark-function)
92(define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block)
93(define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
94(define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
95(define-key pascal-mode-map "\M-*" 'pascal-star-comment)
96
97;;; A command to change the whole buffer won't be used terribly
98;;; often, so no need for a key binding.
99;;;(define-key pascal-mode-map "\C-c\C-l" 'pascal-downcase-keywords)
100;;;(define-key pascal-mode-map "\C-c\C-u" 'pascal-upcase-keywords)
101;;;(define-key pascal-mode-map "\C-c\C-c" 'pascal-capitalize-keywords)
102
103(defvar pascal-keywords '("and" "array" "begin" "case" "const" "div" "do"
104"downto" "else" "end" "file" "for" "function" "goto" "if" "in" "label" "mod"
105"nil" "not" "of" "or" "packed" "procedure" "program" "record" "repeat" "set"
106"then" "to" "type" "until" "var" "while" "with"
107;; The following are not standard in pascal, but widely used.
108"get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
109"writeln"))
110
111(defvar pascal-mode-syntax-table nil
112 "Syntax table in use in Pascal-mode buffers.")
113
114(if pascal-mode-syntax-table
115 ()
116 (setq pascal-mode-syntax-table (make-syntax-table))
117 (modify-syntax-entry ?\\ "\\" pascal-mode-syntax-table)
118 (modify-syntax-entry ?( ". 1" pascal-mode-syntax-table)
119 (modify-syntax-entry ?) ". 4" pascal-mode-syntax-table)
120 (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table)
121 (modify-syntax-entry ?{ "<" pascal-mode-syntax-table)
122 (modify-syntax-entry ?} ">" pascal-mode-syntax-table)
123 (modify-syntax-entry ?+ "." pascal-mode-syntax-table)
124 (modify-syntax-entry ?- "." pascal-mode-syntax-table)
125 (modify-syntax-entry ?= "." pascal-mode-syntax-table)
126 (modify-syntax-entry ?% "." pascal-mode-syntax-table)
127 (modify-syntax-entry ?< "." pascal-mode-syntax-table)
128 (modify-syntax-entry ?> "." pascal-mode-syntax-table)
129 (modify-syntax-entry ?& "." pascal-mode-syntax-table)
130 (modify-syntax-entry ?| "." pascal-mode-syntax-table)
131 (modify-syntax-entry ?_ "w" pascal-mode-syntax-table)
132 (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table))
133
134(defconst pascal-indent-level 3
135 "*Indentation of Pascal statements with respect to containing block.")
136(defconst pascal-continued-expr 1
137 "*Indentation of line that is a continued expression.")
138(defconst pascal-label-offset -1
139 "*Offset of Pascal label lines, case statements and record lines.
140This is relative to usual indentation.")
141(defconst pascal-case-offset 2
142 "*Indentation after case statements.")
143(defconst pascal-vardecl-indent 15
144 "*Indentation (from the beginning of line to `:' of the declaration.")
145(defconst pascal-typedecl-indent 10
146 "*Indentation (from the beginning of line to `=' of the declaration.")
147(defconst pascal-auto-newline nil
148 "*Non-nil means automatically newline after semicolons and `end'.")
149(defconst pascal-tab-always-indent t
150 "*Non-nil means TAB in Pascal mode should always reindent the current line.
151It does so regardless of where in the line point is
152when the TAB command is used.")
153(defconst pascal-auto-endcomments t
154 "*Non-nil means make a comment { ... } after the end for a case or function.
155The name of the function or case is put between the braces.")
156
157;;;###autoload
158(defun pascal-mode ()
159 "Major mode for editing Pascal code.
160Tab indents for Pascal code.
161Delete converts tabs to spaces as it moves back.
162\\{pascal-mode-map}
163Variables controlling indentation style:
164 pascal-tab-always-indent (default t)
165 Non-nil means TAB in Pascal mode should always reindent the current line,
166 regardless of where in the line point is when the TAB command is used.
167 pascal-auto-newline (default nil)
168 Non-nil means automatically newline after semicolons and the punctation
169 mark after an end.
170 pascal-auto-endcomments (default t)
171 Non-nil means automatically set name of function or `case' in braces after
172 after the `end' if this end ends a function or a case block.
173 pascal-indent-level (default 3)
174 Indentation of Pascal statements within surrounding block.
175 pascal-continued-expr (default 1)
176 Indentation of a line that is a continued expression.
177 pascal-typedecl-indent (default 10)
178 Indentation to the `=' in type declarations. (Or constant declarations.)
179 pascal-vardecl-indent (default 20)
180 Indentation to the `:' in var declarations.
181 pascal-label-offset (default -1)
182 Extra indentation for line that is a label, case statement or part of
183 a record block.
184 pascal-case-offset (default 2)
185 Extra indent to the `:' in case statements.
186
187The only auto indention this mode doesn't fully support is if there is a
188case within a type declaration. However, this is seldom used.
189
190When typing text, you should not worry about to get right indentions, they
191will be set when you hit return. The mode will also automatically delete the
192whitespaces between `*' and `)' when ending a starcomment.
193
194Turning on Pascal mode calls the value of the variable pascal-mode-hook with
195no args, if that value is non-nil."
196 (interactive)
197 (kill-all-local-variables)
198 (use-local-map pascal-mode-map)
199 (setq major-mode 'pascal-mode)
200 (setq mode-name "Pascal")
201 (setq local-abbrev-table pascal-mode-abbrev-table)
202 (set-syntax-table pascal-mode-syntax-table)
203 (make-local-variable 'indent-line-function)
204 (setq indent-line-function 'pascal-indent-line)
205 (setq comment-indent-hook 'pascal-indent-within-comment)
206 (make-local-variable 'parse-sexp-ignore-comments)
207 (setq parse-sexp-ignore-comments t)
208 (make-local-variable 'case-fold-search)
209 (setq case-fold-search t)
210 (run-hooks 'pascal-mode-hook))
211
212;;;
213;;; Electric functions
214;;;
215
216(defun electric-pascal-terminate-line ()
217 "Terminate line and indent next line."
218 (interactive)
219 (save-excursion
220 (beginning-of-line)
221 (skip-chars-forward " \t")
222 (if (looking-at "until\\b\\|end\\(\\b\\|;\\|\\.\\)\\|begin\\b\\|repeat\\b\\|else\\b")
223 (pascal-indent-line)))
224 (newline)
225 (pascal-indent-line)
226 ;; Maybe we should set some endcomments
227 (if pascal-auto-endcomments
228 (pascal-set-auto-comments))
229 ;; Check if we shall indent inside comment
230 (let ((setstar nil))
231 (save-excursion
232 (forward-line -1)
233 (skip-chars-forward " \t")
234 (cond ((looking-at "\\*[ \t]*)")
235 ;; Delete region between `*' and `)' if there is only whitespaces.
236 (forward-char 1)
237 (pascal-delete-whitespaces))
238 ((and (looking-at "(\\*\\|\\*[^)]")
239 (not (save-excursion
240 (search-forward "*)" (pascal-get-end-of-line) t))))
241 (setq setstar t))))
242 ;; If last line was a star comment line then this one shall be too.
243 (if setstar
244 (progn
245 (insert "*")
246 (pascal-indent-command))
247 (pascal-indent-line))))
248
249(defun electric-pascal-semi ()
250 "Insert ; character and correct this line's indention."
251 (interactive)
252 (insert last-command-char)
253 (save-excursion
254 (beginning-of-line)
255 (pascal-indent-line))
256 (if pascal-auto-newline
257 (electric-pascal-terminate-line)))
258
259(defun electric-pascal-dot ()
260 "Insert a period and correct this line's indention."
261 (interactive)
262 (insert last-command-char)
263 (save-excursion
264 (beginning-of-line)
265 (pascal-indent-line))
266 (if pascal-auto-newline
267 (electric-pascal-terminate-line)))
268
269(defun electric-pascal-colon ()
270 "Insert : and do all indentions except line indent on this line."
271 (interactive)
272 (insert last-command-char)
273 ;; Do nothing of within string.
274 (if (not (pascal-within-string))
275 (progn
276 (if (save-excursion
277 (backward-char 2)
278 (looking-at "[0-9]"))
279 (save-excursion
280 (beginning-of-line)
281 (pascal-indent-line)))
282 (let ((pascal-tab-always-indent nil))
283 (pascal-indent-command)))))
284
285(defun electric-pascal-equal ()
286 "Insert = and do indention if within type declaration."
287 (interactive)
288 (insert last-command-char)
289 (if (eq (nth 1 (pascal-calculate-indent t)) 'decl)
290 (let ((pascal-tab-always-indent nil))
291 (pascal-indent-command))))
292
293(defun electric-pascal-tab ()
294 "Function called when tab is pressed."
295 (interactive)
296 ;; Do nothing if within a string.
297 (if (not (pascal-within-string))
298 ;; If pascal-tab-always-indent is set then indent the beginning of
299 ;; the line.
300 (progn
301 (if pascal-tab-always-indent
302 (save-excursion
303 (beginning-of-line)
304 (pascal-indent-line)))
305 (pascal-indent-command))))
306
307;;;
308;;; Interactive functions
309;;;
310(defun pascal-insert-block ()
311 "Insert begin ... end; block in the code with right indents."
312 (interactive)
313 (pascal-indent-line)
314 (insert "begin")
315 (electric-pascal-terminate-line)
316 (save-excursion
317 (electric-pascal-terminate-line)
318 (insert "end;")
319 (beginning-of-line)
320 (pascal-indent-line)))
321
322(defun pascal-star-comment ()
323 "Insert star comment in the code."
324 (interactive)
325 (pascal-indent-line)
326 (insert "(*")
327 (electric-pascal-terminate-line)
328 (save-excursion
329 (electric-pascal-terminate-line)
330 (pascal-delete-whitespaces)
331 (insert ")")))
332
333(defun pascal-mark-function ()
334 "Mark the current pascal function (or procedure).
335Put the mark at the end of the function, and point at the beginning."
336 (interactive)
337 (push-mark (point))
338 (pascal-forward-to-end-of-function)
339 (push-mark (point))
340 (pascal-backward-to-beginning-of-function)
341 (zmacs-activate-region))
342
343(defun pascal-comment-area (start end)
344 "Put the current region in a comment.
345The comments that are in this area are
346be changed so that `*)' becomes `!(*' and `}' becomes `!{'. These will
347however be turned back to normal when the area is uncommented by pressing
348\\[pascal-uncomment-area].
349The commented area starts with: `{---\\/---EXCLUDED---\\/---' , and ends with:
350` ---/\\---EXCLUDED---/\\---}'. If these texts are changed, uncomment-area
351will not be able to recognize them."
352 (interactive "r")
353 (save-excursion
354 ;; Insert start and endcomments
355 (goto-char end)
356 (if (and (save-excursion (skip-chars-forward " \t") (eolp))
357 (not (save-excursion (skip-chars-backward " \t") (bolp))))
358 (forward-line 1)
359 (beginning-of-line))
360 (insert " ---/\\---EXCLUDED---/\\---}")
361 (setq end (point))
362 (newline)
363 (goto-char start)
364 (beginning-of-line)
365 (insert "{---\\/---EXCLUDED---\\/--- ")
366 (newline)
367 ;; Replace end-comments within commented area
368 (goto-char end)
369 (save-excursion
370 (while (re-search-backward "\\*)" start t)
371 (replace-match "!(*" t t)))
372 (save-excursion
373 (while (re-search-backward "}" start t)
374 (replace-match "!{" t t)))))
375
376(defun pascal-uncomment-area ()
377 "Uncomment a commented area.
378Change all deformed comments in this area back to normal.
379This function does nothing if the pointer is not in a commented
380area. See also `pascal-comment-area'."
381 (interactive)
382 (save-excursion
383 (let ((start (point))
384 (end (point)))
385 ;; Find the boundaries of the comment
386 (save-excursion
387 (setq start (progn (search-backward "{---\\/---EXCLUDED---\\/--" nil t)
388 (point)))
389 (setq end (progn (search-forward "---/\\---EXCLUDED---/\\---}" nil t)
390 (point))))
391 ;; Check if we're really inside a comment
392 (if (or (equal start (point)) (<= end (point)))
393 (message "Not standing within commented area.")
394 (progn
395 ;; Remove endcomment
396 (goto-char end)
397 (beginning-of-line)
398 (let ((pos (point)))
399 (end-of-line)
400 (delete-region pos (1+ (point))))
401 ;; Change comments back to normal
402 (save-excursion
403 (while (re-search-backward "!{" start t)
404 (replace-match "}" t t)))
405 (save-excursion
406 (while (re-search-backward "!(\\*" start t)
407 (replace-match "*)" t t)))
408 ;; Remove startcomment
409 (goto-char start)
410 (beginning-of-line)
411 (let ((pos (point)))
412 (end-of-line)
413 (delete-region pos (1+ (point)))))))))
414
415(defun pascal-backward-to-beginning-of-function ()
416 "Move backwards to the beginning of this function or procedure."
417 (interactive)
418 ;; Check if this is a
419 (if (save-excursion
420 (re-search-backward "\\<end" nil t)
421 (looking-at "end\\."))
422 (beginning-of-buffer)
423 (let ((nest-depth 0) (nest-max 0)
424 (nest-noexit 1))
425 (beginning-of-line)
426 ;; First we find the max depth of the nesting
427 (save-excursion
428 (while (not (or (bobp) (looking-at "function\\b\\|procedure\\b")))
429 (backward-sexp 1)
430 (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b")
431 (setq nest-depth (1+ nest-depth)))
432 ((looking-at "end\\(\\b\\|;\\|\\.\\)")
433 (setq nest-depth (1- nest-depth))))
434 (setq nest-max (max nest-depth nest-max))))
435 ;; Then we can start searching
436 (setq nest-depth 0)
437 (while (not (or (bobp) (and (looking-at "function\\b\\|procedure\\b")
438 (zerop nest-noexit))))
439 (backward-sexp 1)
440 (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b")
441 (setq nest-depth (1+ nest-depth)))
442 ((looking-at "end\\(\\b\\|;\\|\\.\\)")
443 (if (equal nest-depth nest-max)
444 (setq nest-noexit (1+ nest-noexit)))
445 (setq nest-depth (1- nest-depth)))
446 ((looking-at "function\\b\\|procedure\\b")
447 (setq nest-noexit (1- nest-noexit))))))))
448
449(defun pascal-forward-to-end-of-function ()
450 "Moves the point to the end of the function."
451 (interactive)
452 (if (not (looking-at "function\\b\\|procedure\\b"))
453 (pascal-backward-to-beginning-of-function))
454 (if (bobp)
455 (end-of-buffer)
456 (progn
457 (let ((nest-depth 0)
458 (func-depth 1))
459 (while (not (or (and (zerop nest-depth) (zerop func-depth)) (eobp)))
460 (forward-sexp 2)
461 (if (not (eobp))
462 (progn
463 (backward-sexp 1) ; Move to the beginning of the next sexp
464 (cond ((looking-at "begin\\b\\|case\\b\\|record\\b")
465 (setq nest-depth (1+ nest-depth)))
466 ((looking-at "end\\(\\b\\|;\\|\\.\\)")
467 (setq nest-depth (1- nest-depth))
468 (if (zerop nest-depth)
469 (setq func-depth (1- func-depth))))
470 ((looking-at "function\\b\\|procedure\\b")
471 (setq func-depth (1+ func-depth)))))))
472 (end-of-line)))))
473
474(defun pascal-downcase-keywords ()
475 "Makes all Pascal keywords in the buffer lowercase."
476 (interactive)
477 (pascal-change-keywords 'downcase-word))
478
479(defun pascal-upcase-keywords ()
480 "Makes all Pascal keywords in the buffer uppercase."
481 (interactive)
482 (pascal-change-keywords 'upcase-word))
483
484(defun pascal-capitalize-keywords ()
485 "Makes all Pascal keywords in the buffer uppercase."
486 (interactive)
487 (pascal-change-keywords 'capitalize-word))
488
489(defun pascal-change-keywords (change-word)
490 "Change the keywords according to argument."
491 (save-excursion
492 (beginning-of-buffer)
493 (while (re-search-forward (mapconcat
494 'downcase pascal-keywords "\\>\\|\\<") nil t)
495 (funcall change-word -1))))
496
497;;;
498;;; Other functions
499;;;
500(defun pascal-delete-whitespaces ()
501 "Deletes the whitespaces around the current point."
502 (interactive)
503 (let ((pos (progn (skip-chars-backward " \t") (point))))
504 (skip-chars-forward " \t")
505 (delete-region pos (point))))
506
507(defun pascal-get-beg-of-line ()
508 (save-excursion
509 (beginning-of-line)
510 (point)))
511
512(defun pascal-get-end-of-line ()
513 (save-excursion
514 (end-of-line)
515 (point)))
516
517(defun pascal-within-string ()
518 "Return t if within string; nil otherwise."
519 (and (save-excursion (search-backward "\"" (pascal-get-beg-of-line) t))
520 (save-excursion (not (search-backward "\"" (pascal-get-beg-of-line) t 2)))))
521
522(defun pascal-check-if-within-comment ()
523 "If within a comment, return the correct indent. Return nil otherwise."
524 (let ((comstart (point))
525 (comend (point)))
526 (save-excursion
527 (if (re-search-backward "(\\*\\|{" nil t)
528 (setq comstart (point))
529 (setq comstart 0)))
530 (save-excursion
531 (if (re-search-backward "\\*)\\|}" nil t)
532 (setq comend (point))
533 (setq comend 0)))
534 (if (< comend comstart)
535 (save-excursion
536 (goto-char comstart)
537 ;; Add 1 to indent if this is a starcomment
538 (if (looking-at "(\\*")
539 (1+ (current-column))
540 (current-column)))
541 nil)))
542
543(defun pascal-set-auto-comments ()
544 "Put { case } or { FUNNAME } on this line if appropriate after `end'."
545 (save-excursion
546 (forward-line -1)
547 (skip-chars-forward " \t")
548 (if (and (looking-at "end\\(\>\\|;\\)")
549 (not (save-excursion
550 (end-of-line)
551 (search-backward "}" (pascal-get-beg-of-line) t))))
552 (progn
553 (if (eq (nth 1 (pascal-calculate-indent)) 'case)
554 ;; This is a case block
555 (progn
556 (end-of-line)
557 (pascal-delete-whitespaces)
558 (insert " { case }"))
559 (let ((nest 1))
560 ;; Check if this is the end of a function
561 (save-excursion
562 (while (not (or (looking-at "function\\b\\|\\procedure\\b")
563 (bobp)))
564 (backward-sexp 1)
565 (cond ((looking-at "begin\\b\\|case\\b")
566 (setq nest (1- nest)))
567 ((looking-at "end\\(\\b\\|;\\|\\.\\)")
568 (setq nest (1+ nest)))))
569 (if (bobp)
570 (setq nest 1)))
571 (if (zerop nest)
572 (let ((last-command nil))
573 ;; Find the function name and put it in braces
574 (save-excursion
575 (pascal-backward-to-beginning-of-function)
576 (skip-chars-forward "^ \t")
577 (skip-chars-forward " \t")
578 (copy-region-as-kill (point)
579 (save-excursion
580 (skip-chars-forward "a-zA-Z0-9_")
581 (point))))
582 (end-of-line)
583 (pascal-delete-whitespaces)
584 (insert " { ")
585 ;; We've filled up the kill ring, but hey, who cares?
586 (yank) (rotate-yank-pointer 1)
587 (insert " }")))))))))
588
589;;;
590;;; Indent functions and calculation of indent
591;;;
592(defun pascal-indent-command ()
593 "Indent current line as Pascal code and/or indent within line."
594 ;; Call pascal-indent-line. This does nothing if we're not at the
595 ;; beginning of the line.
596 (pascal-indent-line)
597 (let ((indent (pascal-calculate-indent t))
598 (pos 0))
599 (save-excursion
600 (cond ((or (eq (nth 1 indent) 'case)
601 (eq (nth 1 indent) 'record))
602 ;; Indent for case and record blocks
603 (beginning-of-line)
604 (if (search-forward ":" (pascal-get-end-of-line) t)
605 (progn
606 ;; Indent before colon
607 (backward-char 1)
608 (pascal-delete-whitespaces)
609 (indent-to (max (pascal-find-leading-case-colon)
610 (1+ (current-column))))
611 ;; Indent after colon
612 (forward-char 1)
613 (pascal-delete-whitespaces)
614 (indent-to (1+ (current-column))))
615 ;; Indent if there is no colon
616 (progn
617 (beginning-of-line)
618 (skip-chars-forward " \t")
619 (if (not (eolp))
620 (progn
621 (skip-chars-forward "0-9a-zA-Z\"\'_;")
622 (pascal-delete-whitespaces)
623 (indent-to (max (pascal-find-leading-case-colon)
624 (1+ (current-column)))))))))
625 ((eq (nth 1 indent) 'decl)
626 ;; Indent for declarations
627 (let ((posii (pascal-get-beg-of-line)))
628 (re-search-backward "\\<\\(var\\|type\\|const\\|label\\)\\>"
629 nil t)
630 (cond ((looking-at "var\\b")
631 (pascal-declindent-middle-of-line
632 ":" posii pascal-vardecl-indent))
633 ((looking-at "type\\b\\|const\\b")
634 (pascal-declindent-middle-of-line
635 "=" posii pascal-typedecl-indent)))))
636 ((eq (nth 1 indent) 'function)
637 ;; Indent for parameterlist
638 ;; Done twice in case something has changed
639 (pascal-indent-parameter-list)
640 (pascal-indent-parameter-list))))
641 ;; Go to the end of a line if rest of line contains only whitespaces
642 (if (save-excursion (skip-chars-forward " \t") (eolp))
643 (end-of-line))))
644
645(defun pascal-indent-line ()
646 "Indent current line as Pascal code."
647 (let ((indent (list 0 nil))
648 (comindent 0)
649 beg (point))
650 (save-excursion
651 (beginning-of-line)
652 (setq indent (pascal-calculate-indent)))
653 ;; If we are inside a comment, do special indent.
654 (if (setq comindent (pascal-check-if-within-comment))
655 (pascal-indent-within-comment comindent)
656 ;; Skip the rest if we're not standing on the beginning of a line.
657 (if (save-excursion (skip-chars-backward " \t") (bolp))
658 (progn
659 (beginning-of-line)
660 (pascal-delete-whitespaces)
661 ;; When to skip the ekstra indent:
662 ;; If we are standing at end or until.
663 ;; If we are in an if statement and standing at else,
664 ;; begin or repeat
665 ;; If we are in a with, while or for statement and standing
666 ;; at begin or end.
667 (cond ((or (or (looking-at "end\\b\\|until\\b")
668 (not (nth 1 indent)))
669 (and (eq (nth 1 indent) 'if)
670 (looking-at "begin\\b\\|\\repeat\\b\\|else\\b"))
671 (and (eq (nth 1 indent) 'whilewith)
672 (looking-at "begin\\b\\|\\repeat\\b")))
673 (indent-to (car indent)))
674 ;; Continued expression
675 ((eq (nth 1 indent) 'contexp)
676 (indent-to (+ (car indent) pascal-continued-expr)))
677 ;; If this is a part of a case or record block,
678 ;; then modify the indent level.
679 ((or (eq (nth 1 indent) 'case)
680 (eq (nth 1 indent) 'record))
681 (indent-to (+ (car indent) pascal-indent-level
682 pascal-label-offset)))
683 ;; If this is a label - don't indent.
684 ((looking-at "[0-9]*:")
685 (skip-chars-forward "0-9:")
686 (pascal-delete-whitespaces)
687 (indent-to (+ (car indent) pascal-indent-level)))
688 ;; If this is insde a parameter list, do special indent
689 ((eq (nth 1 indent) 'function)
690 (pascal-indent-parameter-list))
691 ;; All other indents are set normaly.
692 (t
693 (indent-to (+ (car indent) pascal-indent-level)))))))))
694
695(defun pascal-calculate-indent (&optional arg)
696 "Search backward in code to find the right indent level.
697Return a list containing:
6981. Indent level
6992. The indent keyword (begin, case etc.), or nil if backtracking failed.
700If arg is non-nil, we do not search for continued expressions."
701 (let ((pascal-nest-depth 1)
702 (oldpos (save-excursion (forward-line -1) (end-of-line) (point)))
703 (samepos (point)) (if-is-set t)
704 (return-struct (list 0 nil)) (pos 0)
705 (contexpr nil) (after-contexpr (not arg))
706 (case-fold-search t))
707 (save-excursion
708 (while (and (not (zerop pascal-nest-depth))
709 (not (bobp)))
710 (progn
711 (backward-sexp 1)
712 (if (save-excursion
713 (setq pos (point))
714 (end-of-line)
715 (search-backward ";" pos t))
716 (setq if-is-set nil
717 after-contexpr nil))
718 (if (looking-at "then\\b\\|end\\b\\|else\\b\\|do\\b")
719 (setq after-contexpr nil))
720
721 (cond ((looking-at "begin\\b\\|case\\b\\|record\\b\\|repeat\\b")
722 (setq pascal-nest-depth (1- pascal-nest-depth)))
723 ;;
724 ;; END | UNTIL
725 ((looking-at "end\\(\\b\\|;\\|\\.\\)\\|until\\b")
726 (setq if-is-set nil)
727 (if after-contexpr
728 (setq pascal-nest-depth 0
729 contexpr t)
730 (setq pascal-nest-depth (1+ pascal-nest-depth))))
731 ;;
732 ;; IF | ELSE | WITH | WHILE | FOR
733 ;; LABEL | CONST | TYPE | FUNCTION | PROCEDURE
734 ((or (and (looking-at "if\\b\\|else\\b\\|with\\b\\|while\\b\\|for\\b")
735 if-is-set)
736 (looking-at "label\\b\\|const\\b\\|type\\b\\|function\\b\\|procedure\\b"))
737 (setq pascal-nest-depth 0))
738 ;;
739 ;; VAR
740 ((looking-at "var\\b")
741 ;; A `var' can be in a declaration part or parameter part
742 (let ((stpos 0) (edpos 0))
743 (save-excursion
744 (if (not (re-search-backward
745 "\\<\\(function\\|procedure\\)\\>" nil t))
746 (beginning-of-buffer))
747 (setq stpos (save-excursion
748 (search-forward "(" nil t) (point)))
749 (setq edpos (save-excursion
750 (search-forward ")" nil t) (point))))
751 (cond ((or (= stpos edpos) (< samepos stpos)
752 (and (> (point) edpos) (> edpos stpos)))
753 ;; This is really a declaration block!!
754 nil)
755 ((and (>= samepos stpos) (or (< samepos edpos)
756 (> stpos edpos)))
757 ;; Hmm... part of a parameter
758 (re-search-backward
759 "\\<\\(function\\|procedure\\)\\>" nil t))
760 (t
761 ;; This is just after a parameter declaration
762 (forward-char 1)))
763 ;; We'll quit anyway
764 (setq pascal-nest-depth 0)))
765 ;;
766 ;; CONTINUED EXPRESSIONS
767 (after-contexpr
768 (save-excursion
769 ;; First, we have to be at the begining of a line
770 (if (and (progn (skip-chars-backward " \t") (bolp))
771 ;; Blank lines don't count
772 (not (progn (skip-chars-forward " \t") (eolp)))
773 ;; But nonblank without ';' do
774 (not (search-forward ";" (pascal-get-end-of-line) t)))
775 (save-excursion
776 (forward-line -1)
777 (end-of-line)
778 (backward-sexp 1)
779 (if (or (looking-at "\\(do\\|then\\|of\\\|begin\\|repeat\\|else\\)\\>")
780 (progn
781 (skip-chars-forward "^; " (pascal-get-end-of-line))
782 (equal (char-to-string (following-char))
783 ";")))
784 (setq pascal-nest-depth 0))
785 (setq contexpr t)))))
786 )))
787 (cond (contexpr
788 (setq return-struct (list (pascal-lstart-col) 'contexp)))
789 ((looking-at "begin\\b")
790 (setq return-struct (list (pascal-lstart-col) 'begin)))
791 ((looking-at "else\\b")
792 (setq return-struct (list (save-excursion
793 (re-search-backward "if\\b" nil t)
794 (pascal-lstart-col)) 'if))
795 ;; Indent line in case this is a multiple if
796 (beginning-of-line)
797 (pascal-delete-whitespaces)
798 (indent-to (car return-struct)))
799 ((looking-at "if\\b")
800 (if (save-excursion
801 (narrow-to-region (pascal-get-beg-of-line) (point))
802 (backward-sexp 1)
803 (widen)
804 (looking-at "else\\b"))
805 ;; Indent line if this is a multiple if
806 (progn
807 (beginning-of-line)
808 (pascal-delete-whitespaces)
809 (indent-to (save-excursion
810 (re-search-backward "if\\b" nil t)
811 (pascal-lstart-col)))))
812 ;; This could be a continued expression
813 (if (and after-contexpr
814 (not (save-excursion (re-search-forward
815 "then\\b" (pascal-get-end-of-line) t))))
816 (setq return-struct (list (pascal-lstart-col) 'contexp))
817 (setq return-struct (list (pascal-lstart-col) 'if))))
818 ((looking-at "repeat\\b")
819 (setq return-struct (list (pascal-lstart-col) 'repeat)))
820 ((looking-at "case\\b")
821 (setq return-struct (list (current-column) 'case)))
822 ((looking-at "record\\b")
823 (setq return-struct (list (current-column) 'record)))
824 ((looking-at "while\\b\\|with\\b\\|for\\b")
825 ;; This could ba a continued expression
826 (if (and after-contexpr
827 (not (save-excursion (re-search-forward
828 "do\\b" (pascal-get-end-of-line) t))))
829 (setq return-struct (list (pascal-lstart-col) 'contexp))
830 (setq return-struct (list (current-column) 'whilewith))))
831 ((looking-at "procedure\\b\\|function\\b")
832 ;; Make sure that this is a function with parameters, and
833 ;; that we are actually standing inside the paranthesis.
834 (let ((spos (save-excursion
835 (search-forward "(" samepos t) (point)))
836 (epos (save-excursion
837 (search-forward ")" samepos t) (point))))
838 (if (and (>= samepos spos) (or (< samepos epos)
839 (> spos epos)))
840 (setq return-struct (list 0 'function))
841 (setq return-struct (list 0 nil)))))
842 ((looking-at "var\\b\\|label\\b\\|const\\b\\|type\\b")
843 ;; Are we really in the declaration part?(Check for blank lines)
844 (if (< oldpos (point))
845 (setq return-struct (list 0 'decl))
846 (if (save-excursion
847 (not (re-search-forward "^[ \t]*$" oldpos t)))
848 (setq return-struct (list 0 'decl))
849 (setq return-struct (list 0 nil)))))
850 (t
851 (setq return-struct (list 0 nil))))
852 return-struct)))
853
854(defun pascal-lstart-col ()
855 "Return the column of the beginning of the first command on the line."
856 (save-excursion
857 (beginning-of-line)
858 (skip-chars-forward ":0-9")
859 (skip-chars-forward " \t")
860 (current-column)))
861
862(defun pascal-indent-parameter-list ()
863 "Indent this line as part of a parameter list in a function."
864 (let ((indents (pascal-get-highest-indents-in-parameterlist))
865 (pos 0))
866 (if (not (progn (beginning-of-line)
867 (search-forward "(" (pascal-get-end-of-line) t)))
868 (progn (beginning-of-line)
869 (skip-chars-forward " \t")))
870 ;; Indent region in front of var
871 (skip-chars-forward " \t")
872 (pascal-delete-whitespaces)
873 (indent-to (nth 0 indents))
874 (if (looking-at "var\\b")
875 (forward-char 3))
876 ;; Indent parameternames
877 (pascal-delete-whitespaces)
878 (indent-to (nth 1 indents))
879 (if (not (save-excursion (skip-chars-forward " \t") (eolp)))
880 (progn
881 ;; Indent colon
882 (if (search-forward ":" (pascal-get-end-of-line) t)
883 (backward-char 1)
884 (end-of-line))
885 (pascal-delete-whitespaces)
886 (indent-to (nth 2 indents))
887 ;; Indent after colon
888 (if (equal (following-char) ?:)
889 (progn
890 (forward-char 1)
891 (pascal-delete-whitespaces)
892 (indent-to (+ 2 (nth 2 indents)))))))))
893
894;; Get the indents to use in a parameterlist.
895;; Returns:
896;; 1. Indent to the beginning of the line.
897;; 2. Indent to the beginning of the parameter names.
898;; 3. Indent to the right colon position."
899(defun pascal-get-highest-indents-in-parameterlist ()
900 (save-excursion
901 (let ((start (progn
902 (re-search-backward
903 "\\<\\(function\\|procedure\\)\\>" nil t)
904 (search-forward "(")
905 (current-column)))
906 (arglength 0) (vardecl nil) (done nil))
907 (while (not (or done (eobp)))
908 (beginning-of-line)
909 (if (save-excursion
910 (re-search-forward "\\<var\\>" (pascal-get-end-of-line) t))
911 (setq vardecl t))
912 (if (not (re-search-forward ":" (pascal-get-end-of-line) t))
913 (setq done t))
914 (skip-chars-backward ": \t")
915 (setq arglength (max arglength (current-column)))
916 (forward-line 1))
917 (if vardecl
918 (list start (+ start 4) (1+ arglength))
919 (list start start (1+ arglength))))))
920
921(defun pascal-declindent-middle-of-line (declkey endpos defaultindent)
922 "Indent declaration line."
923 (let ((decindent 0))
924 (if (search-forward declkey endpos t)
925 (setq decindent (1- (current-column)))
926 (setq decindent defaultindent))
927 (goto-char endpos)
928 (end-of-line)
929 (if (save-excursion (search-backward declkey endpos t))
930 (progn (search-backward declkey) (skip-chars-backward " \t"))
931 (skip-chars-backward " \t"))
932 (pascal-delete-whitespaces)
933 (indent-to (max decindent (1+ (current-column))))
934 ;; Indent after `declkey'
935 (if (looking-at declkey)
936 (progn
937 (forward-char 1)
938 (pascal-delete-whitespaces)
939 (indent-to (1+ (current-column)))))))
940
941(defun pascal-indent-within-comment (indent)
942 "Indent comments and/or indent text within comment."
943 (progn
944 ;; If we are at the beginning of the line, then we indent this line.
945 (if (save-excursion (skip-chars-backward " \t") (bolp))
946 (progn
947 (beginning-of-line)
948 (pascal-delete-whitespaces)
949 (indent-to indent))
950 ;; Do nothing if we're not in a star comment.
951 (if (save-excursion
952 (beginning-of-line)
953 (skip-chars-forward " \t")
954 (looking-at "\\*\\|(\\*"))
955 (save-excursion
956 (beginning-of-line)
957 (search-forward "*")
958 (pascal-delete-whitespaces)
959 (indent-to (+ (current-column) 2)))))))
960
961(defun pascal-find-leading-case-colon ()
962 "Return hpos of first colon after the case-of or record line.
963If there's no such line, use the place where it ought to be."
964 (let ((pos (save-excursion
965 (beginning-of-line)
966 (skip-chars-forward " \t")
967 (point))))
968 (save-excursion
969 (re-search-backward "\\<\\(case\\|record\\)\\>")
970 (forward-line 1)
971 (skip-chars-forward " \t")
972 (if (not (eq pos (point)))
973 (progn
974 (search-forward ":" (pascal-get-end-of-line) t)
975 (1- (current-column)))
976 (+ (current-column) pascal-case-offset)))))
977
978(provide 'pascal)
979
980;; pascal.el ends here.
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
new file mode 100644
index 00000000000..fe62b736566
--- /dev/null
+++ b/lisp/thingatpt.el
@@ -0,0 +1,206 @@
1;;; thingatpt.el --- Get the `thing' at point
2
3;; Copyright (C) 1991,1992,1993 Free Software Foundation, Inc.
4
5;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
6;; Keywords: extensions
7;; Created: Thu Mar 28 13:48:23 1991
8;; Version: $Revision: 1.16 $
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation; either version 2, or (at your option)
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;;; Commentary:
23;;
24;; This file provides routines for getting the `thing' at the location of
25;; point, whatever that `thing' happens to be. The `thing' is defined by
26;; it's beginning and end positions in the buffer.
27;;
28;; The function bounds-of-thing-at-point finds the beginning and end
29;; positions by moving first forward to the end of the `thing', and then
30;; backwards to the beginning. By default, it uses the corresponding
31;; forward-`thing' operator (eg. forward-word, forward-line).
32;;
33;; Special cases are allowed for using properties associated with the named
34;; `thing':
35;;
36;; forward-op Function to call to skip forward over a `thing' (or
37;; with a negative argument, backward).
38;;
39;; beginning-op Function to call to skip to the beginning of a `thing'.
40;; end-op Function to call to skip to the end of a `thing'.
41;;
42;; Reliance on existing operators means that many `things' can be accessed
43;; without further code: eg.
44;; (thing-at-point 'line)
45;; (thing-at-point 'page)
46
47;;; Code:
48
49(provide 'thingatpt)
50
51;;=== Version =============================================================
52
53(defconst thing@pt-version (substring "$Revision: 1.16 $" 11 -2)
54 "The revision number of thing@pt (as string). The complete RCS id is:
55
56 $Id: thing@pt.el,v 1.16 1993/09/30 23:54:56 mike Exp $")
57
58;;=== Basic movement ======================================================
59
60;;;###autoload
61(defun forward-thing (THING &optional N)
62 "Move forward to the end of the next THING."
63 (let ((forward-op (or (get THING 'forward-op)
64 (intern-soft (format "forward-%s" THING)))))
65 (if (fboundp forward-op)
66 (funcall forward-op (or N 1))
67 (error "Can't determine how to move over %ss" THING))))
68
69;;=== General routines ====================================================
70
71;;;###autoload
72(defun bounds-of-thing-at-point (THING)
73 "Determine the start and end buffer locations for the THING at point,
74where THING is an entity for which there is a either a corresponding
75forward-THING operation, or corresponding beginning-of-THING and
76end-of-THING operations, eg. 'word, 'sentence, 'defun.
77 Return a cons cell '(start . end) giving the start and end positions."
78 (let ((orig (point)))
79 (condition-case nil
80 (save-excursion
81 (let ((end (progn
82 (funcall
83 (or (get THING 'end-op)
84 (function (lambda () (forward-thing THING 1)))))
85 (point)))
86 (beg (progn
87 (funcall
88 (or (get THING 'beginning-op)
89 (function (lambda () (forward-thing THING -1)))))
90 (point))))
91 (if (and beg end (<= beg orig) (< orig end))
92 (cons beg end))))
93 (error nil))))
94
95;;;###autoload
96(defun thing-at-point (THING)
97 "Return the THING at point, where THING is an entity defined by
98bounds-of-thing-at-point."
99 (let ((bounds (bounds-of-thing-at-point THING)))
100 (if bounds
101 (buffer-substring (car bounds) (cdr bounds)))))
102
103;;=== Go to beginning/end =================================================
104
105(defun beginning-of-thing (THING)
106 (let ((bounds (bounds-of-thing-at-point THING)))
107 (or bounds (error "No %s here" THING))
108 (goto-char (car bounds))))
109
110(defun end-of-thing (THING)
111 (let ((bounds (bounds-of-thing-at-point THING)))
112 (or bounds (error "No %s here" THING))
113 (goto-char (cdr bounds))))
114
115;;=== Special cases =======================================================
116
117;;--- Sexps ---
118
119(defun in-string-p ()
120 (let ((orig (point)))
121 (save-excursion
122 (beginning-of-defun)
123 (nth 3 (parse-partial-sexp (point) orig)))))
124
125(defun end-of-sexp ()
126 (let ((char-syntax (char-syntax (char-after (point)))))
127 (if (or (eq char-syntax ?\))
128 (and (eq char-syntax ?\") (in-string-p)))
129 (forward-char 1)
130 (forward-sexp 1))))
131
132(put 'sexp 'end-op 'end-of-sexp)
133
134;;--- Lists ---
135
136(put 'list 'end-op (function (lambda () (up-list 1))))
137(put 'list 'beginning-op 'backward-sexp)
138
139;;--- Filenames ---
140
141(defvar file-name-chars "~/A-Za-z0-9---_.${}#%,"
142 "Characters allowable in filenames.")
143
144(put 'filename 'end-op
145 (function (lambda () (skip-chars-forward file-name-chars))))
146(put 'filename 'beginning-op
147 (function (lambda () (skip-chars-backward file-name-chars (point-min)))))
148
149;;--- Whitespace ---
150
151(defun forward-whitespace (ARG)
152 (interactive "p")
153 (if (natnump ARG)
154 (re-search-forward "[ \t]+\\|\n" nil nil ARG)
155 (while (< ARG 0)
156 (if (re-search-backward "[ \t]+\\|\n" nil nil)
157 (or (eq (char-after (match-beginning 0)) 10)
158 (skip-chars-backward " \t")))
159 (setq ARG (1+ ARG)))))
160
161;;--- Buffer ---
162
163(put 'buffer 'end-op 'end-of-buffer)
164(put 'buffer 'beginning-op 'beginning-of-buffer)
165
166;;--- Symbols ---
167
168(defun forward-symbol (ARG)
169 (interactive "p")
170 (if (natnump ARG)
171 (re-search-forward "\\(\\sw\\|\\s_\\)+" nil nil ARG)
172 (while (< ARG 0)
173 (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil nil)
174 (skip-syntax-backward "w_"))
175 (setq ARG (1+ ARG)))))
176
177;;=== Aliases =============================================================
178
179(defun word-at-point () (thing-at-point 'word))
180(defun sentence-at-point () (thing-at-point 'sentence))
181
182(defun read-from-whole-string (STR)
183 "Read a lisp expression from STR, signalling an error if the entire string
184was not used."
185 (let* ((read-data (read-from-string STR))
186 (more-left
187 (condition-case nil
188 (progn (read-from-string (substring STR (cdr read-data)))
189 t)
190 (end-of-file nil))))
191 (if more-left
192 (error "Can't read whole string")
193 (car read-data))))
194
195(defun form-at-point (&optional THING PRED)
196 (let ((sexp (condition-case nil
197 (read-from-whole-string (thing-at-point (or THING 'sexp)))
198 (error nil))))
199 (if (or (not PRED) (funcall PRED sexp)) sexp)))
200
201(defun sexp-at-point () (form-at-point 'sexp))
202(defun symbol-at-point () (form-at-point 'sexp 'symbolp))
203(defun number-at-point () (form-at-point 'sexp 'numberp))
204(defun list-at-point () (form-at-point 'list 'listp))
205
206;; thingatpt.el ends here.