diff options
| author | Richard M. Stallman | 1993-11-08 14:46:50 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1993-11-08 14:46:50 +0000 |
| commit | 1a2b6c5271dcd5276501d104700682f752235e9b (patch) | |
| tree | 7c72b5f88b7913c16a58249521efd3a4c281552b | |
| parent | 794572af7060d1482178b75aef62a5bd0be19c35 (diff) | |
| download | emacs-1a2b6c5271dcd5276501d104700682f752235e9b.tar.gz emacs-1a2b6c5271dcd5276501d104700682f752235e9b.zip | |
Initial revision
| -rw-r--r-- | lisp/mouse-sel.el | 437 | ||||
| -rw-r--r-- | lisp/progmodes/pascal.el | 980 | ||||
| -rw-r--r-- | lisp/thingatpt.el | 206 |
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. | ||
| 162 | If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end | ||
| 163 | of the region nearest to where the mouse last was. | ||
| 164 | If 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. | ||
| 168 | If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will | ||
| 169 | remain highlighted. | ||
| 170 | If 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. | ||
| 174 | Ie. 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 | ||
| 186 | used 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. | ||
| 193 | Called 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. | ||
| 200 | Called 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. | ||
| 207 | Called with no arguments.") | ||
| 208 | |||
| 209 | (defun mouse-sel-determine-selection-type (NCLICKS) | ||
| 210 | "Determine what `thing' \\[mouse-select] and \\[mouse-extend] should | ||
| 211 | select by. The first argument is NCLICKS, is the number of consecutive | ||
| 212 | mouse 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 | |||
| 227 | On click, point & mark are set to click position, and mark is disabled. | ||
| 228 | Dragging extends region/selection. | ||
| 229 | |||
| 230 | Double-clicking on word constituents selects words. | ||
| 231 | Double-clicking on symbol constituents selects symbols. | ||
| 232 | Double-clicking on quotes or parentheses selects sexps. | ||
| 233 | Double-clicking on whitespace selects whitespace. | ||
| 234 | Triple-clicking selects lines. | ||
| 235 | |||
| 236 | Clicking mouse-2 while selecting copies the region to the kill-ring. | ||
| 237 | Clicking mouse-1 or mouse-3 kills the region. | ||
| 238 | |||
| 239 | This 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 | |||
| 256 | See documentation for mouse-select for more details. | ||
| 257 | |||
| 258 | This 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. | ||
| 140 | This 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. | ||
| 151 | It does so regardless of where in the line point is | ||
| 152 | when 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. | ||
| 155 | The 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. | ||
| 160 | Tab indents for Pascal code. | ||
| 161 | Delete converts tabs to spaces as it moves back. | ||
| 162 | \\{pascal-mode-map} | ||
| 163 | Variables 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 | |||
| 187 | The only auto indention this mode doesn't fully support is if there is a | ||
| 188 | case within a type declaration. However, this is seldom used. | ||
| 189 | |||
| 190 | When typing text, you should not worry about to get right indentions, they | ||
| 191 | will be set when you hit return. The mode will also automatically delete the | ||
| 192 | whitespaces between `*' and `)' when ending a starcomment. | ||
| 193 | |||
| 194 | Turning on Pascal mode calls the value of the variable pascal-mode-hook with | ||
| 195 | no 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). | ||
| 335 | Put 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. | ||
| 345 | The comments that are in this area are | ||
| 346 | be changed so that `*)' becomes `!(*' and `}' becomes `!{'. These will | ||
| 347 | however be turned back to normal when the area is uncommented by pressing | ||
| 348 | \\[pascal-uncomment-area]. | ||
| 349 | The commented area starts with: `{---\\/---EXCLUDED---\\/---' , and ends with: | ||
| 350 | ` ---/\\---EXCLUDED---/\\---}'. If these texts are changed, uncomment-area | ||
| 351 | will 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. | ||
| 378 | Change all deformed comments in this area back to normal. | ||
| 379 | This function does nothing if the pointer is not in a commented | ||
| 380 | area. 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. | ||
| 697 | Return a list containing: | ||
| 698 | 1. Indent level | ||
| 699 | 2. The indent keyword (begin, case etc.), or nil if backtracking failed. | ||
| 700 | If 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. | ||
| 963 | If 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, | ||
| 74 | where THING is an entity for which there is a either a corresponding | ||
| 75 | forward-THING operation, or corresponding beginning-of-THING and | ||
| 76 | end-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 | ||
| 98 | bounds-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 | ||
| 184 | was 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. | ||