Initial revision

lisp/mouse-sel.el

@@ -0,0 +1,437 @@
+;;; mouse-sel.el --- Multi-click selection support for Emacs 19
+
+;; Copyright (C) 1993 Free Software Foundation, Inc.
+
+;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
+;; Keywords: mouse
+;; Version: $Revision: 1.20 $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;;; Commentary:
+;;
+;; This module provides multi-click mouse support for GNU Emacs versions
+;; 19.18 and later.  I've tried to make it behave more like standard X
+;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
+;; Basically:
+;;
+;;   * Clicking mouse-1 starts (cancels) selection, dragging extends it.
+;;
+;;   * Clicking or dragging mouse-3 extends the selection as well.
+;;
+;;   * Double-clicking on word constituents selects words.
+;;     Double-clicking on symbol constituents selects symbols.
+;;     Double-clicking on quotes or parentheses selects sexps.
+;;     Double-clicking on whitespace selects whitespace.
+;;     Triple-clicking selects lines.
+;;
+;;   * Selecting sets the region & X primary selection, but does NOT affect
+;;     the kill-ring.  Because the mouse handlers set the primary selection
+;;     directly, mouse-sel sets the variables interprogram-cut-function
+;;     and interprogram-paste-function to nil.
+;;
+;;   * Clicking mouse-2 pastes contents of primary selection.
+;;
+;;   * Pressing mouse-2 while selecting or extending copies selected text
+;;     to the kill ring.  Pressing mouse-1 or mouse-3 kills it.
+;;
+;; This module requires my thingatpt.el module, version 1.14 or later, which
+;; it uses to find the bounds of words, lines, sexps, etc.
+;;
+;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
+;;
+;;    You may also want to use one or more of following:
+;;
+;;      ;; Enable region highlight
+;;      (transient-mark-mode 1)
+;;
+;;      ;; But only in the selected window
+;;      (setq highlight-nonselected-windows nil)
+;;      
+;;      ;; Enable pending-delete
+;;      (delete-selection-mode 1)
+;;
+;;--- Customisation -------------------------------------------------------
+;;
+;; * You can control the way mouse-sel binds it's keys by setting the value
+;;   of mouse-sel-default-bindings before loading mouse-sel.
+;;
+;;   (a) If mouse-sel-default-bindings = t (the default)
+;;   
+;;       Mouse sets and pastes selection
+;;	   mouse-1		mouse-select
+;;	   mouse-2		mouse-insert-selection
+;;         mouse-3		mouse-extend
+;;
+;;       Selection/kill-ring interaction is disabled
+;;         interprogram-cut-function   = nil
+;;         interprogram-paste-function = nil
+;;
+;;   (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
+;;   
+;;       Mouse sets selection, and pastes from kill-ring
+;;	   mouse-1		mouse-select
+;;	   mouse-2		mouse-yank-at-click
+;;	   mouse-3		mouse-extend
+;;  
+;;       Selection/kill-ring interaction is retained
+;;         interprogram-cut-function   = x-select-text
+;;         interprogram-paste-function = x-cut-buffer-or-selection-value
+;;         
+;;       What you lose is the ability to select some text in
+;;       delete-selection-mode and yank over the top of it.
+;;       
+;;   (c) If mouse-sel-default-bindings = nil, no bindings are made.
+;;
+;; * I like to leave point at the end of the region nearest to where the
+;;   mouse was, even though this makes region highlighting mis-leading (the
+;;   cursor makes it look like one extra character is selected).  You can
+;;   disable this behaviour with:
+;;
+;;     (setq mouse-sel-leave-point-near-mouse nil)
+;;
+;; * Normally, the selection highlight will be removed when the mouse is
+;;   lifted.  You can tell mouse-sel to retain the selection highlight
+;;   (useful if you don't use transient-mark-mode) with:
+;;
+;;     (setq mouse-sel-retain-highlight t)
+;;
+;; * By default, mouse-select cycles the click count after 3 clicks.  That
+;;   is, clicking mouse-1 four times has the same effect as clicking it
+;;   once, clicking five times has the same effect as clicking twice, etc.
+;;   Disable this behaviour with:
+;;
+;;     (setq mouse-sel-cycle-clicks nil)
+;;
+;; * The variables mouse-sel-{set,get,check}-selection-function control how
+;;   the selection is handled.  Under X Windows, these variables default so
+;;   that the X primary selection is used.  Under other windowing systems,
+;;   alternate functions are used, which simply store the selection value
+;;   in a variable.
+;;
+;;--- Hints ---------------------------------------------------------------
+;;
+;; * You can change the selection highlight face by altering the properties
+;;   of mouse-drag-overlay, eg.
+;;
+;;     (overlay-put mouse-drag-overlay 'face 'bold)
+;;
+;; * Pasting from the primary selection under emacs 19.19 is SLOW (there's
+;;   a two second delay).  The following code will cause mouse-sel to use
+;;   the cut buffer rather than the primary selection.  However, be aware
+;;   that cut buffers are OBSOLETE, and some X applications may not support
+;;   them.
+;;   
+;;     (setq mouse-sel-set-selection-function 'x-select-text
+;;           mouse-sel-get-selection-function 'x-get-cut-buffer)
+;;           
+;;--- Warnings ------------------------------------------------------------
+;;
+;; * When selecting sexps, the selection extends by sexps at the same
+;;   nesting level.  This also means the selection cannot be extended out
+;;   of the enclosing nesting level.  This is INTENTIONAL.
+
+;;; Code:
+
+(provide 'mouse-sel)
+
+(require 'mouse)
+(require 'thingatpt)
+
+;;=== Version =============================================================
+
+(defconst mouse-sel-version (substring "$Revision: 1.20 $" 11 -2)
+  "The revision number of mouse-sel (as string).  The complete RCS id is:
+
+  $Id: mouse-sel.el,v 1.20 1993/09/30 23:57:32 mike Exp $")
+
+;;=== User Variables ======================================================
+
+(defvar mouse-sel-leave-point-near-mouse t
+  "*Leave point near last mouse position.
+If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
+of the region nearest to where the mouse last was.
+If nil, point will always be placed at the beginning of the region.")
+
+(defvar mouse-sel-retain-highlight nil
+  "*Retain highlight on mouse-drag-overlay.
+If non-nil, regions selected using \\[mouse-select] and \\[mouse-extend] will
+remain highlighted.
+If nil, highlighting will be turned off when the mouse is lifted.")
+
+(defvar mouse-sel-cycle-clicks t
+  "*If non-nil, \\[mouse-select] cycles the click-counts after 3 clicks.
+Ie. 4 clicks = 1 click, 5 clicks = 2 clicks, etc.")
+
+(defvar mouse-sel-default-bindings t
+  "Set to nil before loading mouse-sel to prevent default mouse bindings.")
+
+;;=== Selection ===========================================================
+
+(defvar mouse-sel-selection-type nil "Type of current selection")
+(make-variable-buffer-local 'mouse-sel-selection-type)
+
+(defvar mouse-sel-selection "" 
+  "This variable is used to store the selection value when mouse-sel is
+used on windowing systems other than X Windows.")
+
+(defvar mouse-sel-set-selection-function 
+  (if (eq window-system 'x) 
+      (function (lambda (s) (x-set-selection 'PRIMARY s)))
+    (function (lambda (s) (setq mouse-sel-selection s))))
+  "Function to call to set selection.
+Called with one argument, the text to select.")
+
+(defvar mouse-sel-get-selection-function
+  (if (eq window-system 'x) 
+      'x-get-selection 
+    (function (lambda () mouse-sel-selection)))
+  "Function to call to get the selection.
+Called with no argument, it should return the selected text.")
+
+(defvar mouse-sel-check-selection-function
+  (if (eq window-system 'x) 
+      'x-selection-owner-p 
+    nil)
+  "Function to check whether emacs still owns the selection.
+Called with no arguments.")
+
+(defun mouse-sel-determine-selection-type (NCLICKS)
+  "Determine what `thing' \\[mouse-select] and \\[mouse-extend] should
+select by.  The first argument is NCLICKS, is the number of consecutive
+mouse clicks at the same position."
+  (let* ((next-char (char-after (point)))
+	 (char-syntax (if next-char (char-syntax next-char)))
+	 (nclicks (if mouse-sel-cycle-clicks (1+ (% (1- NCLICKS) 3)) NCLICKS)))
+    (cond
+     ((= nclicks 1) nil)
+     ((>= nclicks 3) 'line)
+     ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
+     ((memq next-char '(? ?\t ?\n)) 'whitespace)
+     ((eq char-syntax ?_) 'symbol)
+     ((eq char-syntax ?w) 'word))))
+
+(defun mouse-select (EVENT)
+  "Set region/selection using the mouse.
+
+On click, point & mark are set to click position, and mark is disabled.
+Dragging extends region/selection.
+
+Double-clicking on word constituents selects words.
+Double-clicking on symbol constituents selects symbols.
+Double-clicking on quotes or parentheses selects sexps.
+Double-clicking on whitespace selects whitespace.
+Triple-clicking selects lines.
+
+Clicking mouse-2 while selecting copies the region to the kill-ring.
+Clicking mouse-1 or mouse-3 kills the region.
+
+This should be bound to a down-mouse event."
+  (interactive "e")
+  (mouse-set-point EVENT)
+  (setq mouse-sel-selection-type
+	(mouse-sel-determine-selection-type (event-click-count EVENT)))
+  (let ((object-bounds (bounds-of-thing-at-point mouse-sel-selection-type)))
+    (if object-bounds
+	(progn
+	  (setq mark-active t)
+	  (goto-char (car object-bounds))
+	  (set-mark (cdr object-bounds)))
+      (deactivate-mark)))
+  (mouse-extend))
+
+(defun mouse-extend (&optional EVENT)
+  "Extend region/selection using the mouse.
+
+See documentation for mouse-select for more details.
+
+This should be bound to a down-mouse event."
+  (interactive "e")
+  (if EVENT (select-window (posn-window (event-end EVENT))))
+  (let* ((min (if mark-active (region-beginning) (point)))
+	 (max (if mark-active (region-end) (point)))
+	 (orig-window (selected-window))
+	 (orig-window-frame (window-frame orig-window))
+	 (top (nth 1 (window-edges orig-window)))
+	 (bottom (nth 3 (window-edges orig-window)))
+	 (orig-cursor-type 
+	  (cdr (assoc 'cursor-type (frame-parameters (selected-frame)))))
+	 direction
+	 event)
+
+    ;; Inhibit normal region highlight
+    (setq mark-active nil)
+
+    ;; Highlight region (forcing re-highlight)
+    (move-overlay mouse-drag-overlay min max (current-buffer))
+    (overlay-put mouse-drag-overlay 'face
+		 (overlay-get mouse-drag-overlay 'face))
+
+    ;; Bar cursor
+    (modify-frame-parameters (selected-frame) '((cursor-type . bar)))
+
+    ;; Handle dragging
+    (unwind-protect
+	(progn 
+	  (track-mouse
+	    
+	    (while (if EVENT		; Use initial event
+		       (prog1
+			   (setq event EVENT)
+			 (setq EVENT nil))
+		     (setq event (read-event))
+		     (and (consp event)
+			  (memq (car event) '(mouse-movement switch-frame))))
+		  
+	      (let ((end (event-end event)))
+		    
+		(cond
+		     
+		 ;; Ignore any movement outside the frame
+		 ((eq (car-safe event) 'switch-frame) nil)
+		 ((and (posn-window end)
+		       (not (eq (window-frame (posn-window end))
+				(window-frame orig-window)))) nil)
+		     
+		 ;; Different window, same frame
+		 ((not (eq (posn-window end) orig-window))
+		  (let ((end-row (cdr (cdr (mouse-position)))))
+		    (cond
+		     ((and end-row (not (bobp)) (< end-row top))
+		      (mouse-scroll-subr (- end-row top)
+					 mouse-drag-overlay max))
+		     ((and end-row (not (eobp)) (>= end-row bottom))
+		      (mouse-scroll-subr (1+ (- end-row bottom))
+					 mouse-drag-overlay min))
+		     )))
+
+		 ;; On the mode line
+		 ((eq (posn-point end) 'mode-line)
+		  (mouse-scroll-subr 1 mouse-drag-overlay min))
+
+		 ;; In original window
+		 (t (goto-char (posn-point end)))
+
+		 )
+
+		;; Determine direction of drag
+		(cond
+		 ((and (not direction) (not (eq min max)))
+		  (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
+		 ((and (not (eq direction -1)) (<= (point) min))
+		  (setq direction -1))
+		 ((and (not (eq direction 1)) (>= (point) max))
+		  (setq direction 1)))
+		
+		(if (not mouse-sel-selection-type) nil
+		  
+		  ;; If dragging forward, goal is next character
+		  (if (and (eq direction 1) (not (eobp))) (forward-char 1))
+		  
+		  ;; Move to start/end of selected thing
+		  (let ((goal (point))
+			last)
+		    (goto-char (if (eq 1 direction) min max))
+		    (condition-case nil
+			(progn
+			  (while (> (* direction (- goal (point))) 0)
+			    (setq last (point))
+			    (forward-thing mouse-sel-selection-type 
+					   direction))
+			  (let ((end (point)))
+			    (forward-thing mouse-sel-selection-type
+					   (- direction))
+			    (goto-char
+			     (if (> (* direction (- goal (point))) 0)
+				 end last))))
+		      (error))))
+		
+		;; Move overlay
+		(move-overlay mouse-drag-overlay
+			      (if (eq 1 direction) min (point))
+			      (if (eq -1 direction) max (point))
+			      (current-buffer))
+	      
+		)))			; end track-mouse
+
+	  (let ((overlay-start (overlay-start mouse-drag-overlay))
+		(overlay-end (overlay-end mouse-drag-overlay)))
+
+	    ;; Set region
+	    (if (eq overlay-start overlay-end)
+		(deactivate-mark)
+	      (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
+		  (progn
+		    (set-mark overlay-start)
+		    (goto-char overlay-end))
+		(set-mark overlay-end)
+		(goto-char overlay-start)))
+	    
+	    ;; Set selection
+	    (if (and mark-active mouse-sel-set-selection-function)
+		(funcall mouse-sel-set-selection-function 
+			 (buffer-substring overlay-start overlay-end)))
+	      
+	    ;; Handle copy/kill
+	    (cond
+	     ((eq (car-safe last-input-event) 'down-mouse-2)
+	      (copy-region-as-kill overlay-start overlay-end)
+	      (read-event) (read-event))
+	     ((memq (car-safe last-input-event) '(down-mouse-1 down-mouse-3))
+	      (kill-region overlay-start overlay-end)
+	      (deactivate-mark)
+	      (read-event) (read-event)))))
+
+      ;; Restore cursor
+      (modify-frame-parameters (selected-frame) 
+			       (list (cons 'cursor-type orig-cursor-type)))
+      ;; Remove overlay
+      (or mouse-sel-retain-highlight
+	  (delete-overlay mouse-drag-overlay)))))
+
+(defun mouse-insert-selection (click)
+  "Insert the contents of the selection at mouse click."
+  (interactive "e")
+  (mouse-set-point click)
+  (deactivate-mark)
+  (if mouse-sel-get-selection-function
+      (insert (or (funcall mouse-sel-get-selection-function) ""))))
+
+(defun mouse-sel-validate-selection ()
+  "Remove selection highlight if emacs no longer owns the primary selection."
+  (or (not mouse-sel-check-selection-function)
+      (funcall mouse-sel-check-selection-function)
+      (delete-overlay mouse-drag-overlay)))
+
+(add-hook 'pre-command-hook 'mouse-sel-validate-selection)
+
+;;=== Key bindings ========================================================
+
+(if (not mouse-sel-default-bindings) nil
+  
+  (global-unset-key [mouse-1])
+  (global-unset-key [drag-mouse-1])
+  (global-unset-key [mouse-3])
+  
+  (global-set-key [down-mouse-1]	'mouse-select)
+  (global-set-key [down-mouse-3] 	'mouse-extend)
+  
+  (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
+    
+    (global-set-key [mouse-2] 	'mouse-insert-selection)
+    (setq interprogram-cut-function nil
+	  interprogram-paste-function nil))
+  
+  )
+
+;; mouse-sel.el ends here.

lisp/progmodes/pascal.el

@@ -0,0 +1,980 @@
+;;; pascal.el  -  Major mode for editing pascal source in emacs.
+
+;;; Copyright (C) 1993 Free Software Foundation, Inc.
+
+;; Author: Espen Skoglund (espensk@stud.cs.uit.no)
+;; Keywords: languages
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; If you want to customize the pascal mode in your startup file, you
+;;; can add these lines to your .emacs file (and remove the ;s at the
+;;; beginning of the line):
+;;;
+;;; ;;; Pascal-mode custumization.
+;;; (autoload 'pascal-mode "pascal-mode" nil t)
+;;; (setq auto-mode-alist (append (list (cons "\\.p$" 'pascal-mode)
+;;;                                     (cons "\\.pas$" 'pascal-mode))
+;;;                       auto-mode-alist))
+;;; (setq pascal-mode-hook '(lambda ()
+;;;	                      ;; User specifications
+;;;	                      (setq pascal-tab-always-indent t
+;;;		                   pascal-auto-newline nil
+;;;		                   pascal-auto-endcomments t
+;;;		                   pascal-indent-level 3
+;;;                                pascal-continued-expr 1
+;;;		                   pascal-label-offset -2
+;;;		                   pascal-case-offset 2
+;;;		                   pascal-typedecl-indent 10
+;;; 	 	                   pascal-vardecl-indent 20)))
+
+;;; USAGE
+;;; =====
+;;; If you have modified your startup file as described above, emacs
+;;; should enter pascal-mode when you load a pascal source into emacs.
+;;; If not, you will have to start pascal-mode manually:
+;;;    M-x load-library pascal-mode
+;;;    M-x pascal-mode
+;;; When you have entered pascal-mode, you may get more info by pressing
+;;; C-h m. You may also get online help describing various functions by:
+;;;   C-h d <Name of function you want described>
+
+;;; KNOWN BUGS / BUGREPORTS
+;;; =======================
+;;; As far as I know, there are no bugs in the current version of this
+;;; package. This may not be true however, since I never use this mode
+;;; myself and therefore would never notice them anyway. But if you DO
+;;; find any bugd, you may submitt them to: espensk@stud.cs.uit.no
+
+;;; LCD Archive Entry:
+;;; pascal-mode|Espen Skoglund|espensk@stud.cs.uit.no|
+;;; Major mode for editing Pascal code|
+;;; 14-Sep-93|$Revision: 1.3 $|~/modes/pascal-mode.el.Z|
+
+(defconst pascal-mode-version "1.3"
+  "Version of this pascal mode.")
+
+(defvar pascal-mode-abbrev-table nil
+  "Abbrev table in use in Pascal-mode buffers.")
+(define-abbrev-table 'pascal-mode-abbrev-table ())
+
+(defvar pascal-mode-map ()
+  "Keymap used in Pascal mode.")
+(if (null pascal-mode-map)
+    (setq pascal-mode-map (make-sparse-keymap)))
+
+(define-key pascal-mode-map ";" 'electric-pascal-semi)
+(define-key pascal-mode-map "." 'electric-pascal-dot)
+(define-key pascal-mode-map ":" 'electric-pascal-colon)
+(define-key pascal-mode-map "=" 'electric-pascal-equal)
+(define-key pascal-mode-map "\r" 'electric-pascal-terminate-line)
+(define-key pascal-mode-map "\t" 'electric-pascal-tab)
+(define-key pascal-mode-map "\177" 'backward-delete-char-untabify)
+(define-key pascal-mode-map "\C-\M-a" 'pascal-backward-to-beginning-of-function)
+(define-key pascal-mode-map "\C-\M-e" 'pascal-forward-to-end-of-function)
+(define-key pascal-mode-map "\C-\M-h" 'pascal-mark-function)
+(define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block)
+(define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
+(define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
+(define-key pascal-mode-map "\M-*" 'pascal-star-comment)
+
+;;; A command to change the whole buffer won't be used terribly
+;;; often, so no need for a key binding.
+;;;(define-key pascal-mode-map "\C-c\C-l" 'pascal-downcase-keywords)
+;;;(define-key pascal-mode-map "\C-c\C-u" 'pascal-upcase-keywords)
+;;;(define-key pascal-mode-map "\C-c\C-c" 'pascal-capitalize-keywords)
+
+(defvar pascal-keywords '("and" "array" "begin" "case" "const" "div" "do" 
+"downto" "else" "end" "file" "for" "function" "goto" "if" "in" "label" "mod" 
+"nil" "not" "of" "or" "packed" "procedure" "program" "record" "repeat" "set" 
+"then" "to" "type" "until" "var" "while" "with"
+;; The following are not standard in pascal, but widely used.
+"get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
+"writeln"))
+
+(defvar pascal-mode-syntax-table nil
+  "Syntax table in use in Pascal-mode buffers.")
+
+(if pascal-mode-syntax-table
+    ()
+  (setq pascal-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\\ "\\" pascal-mode-syntax-table)
+  (modify-syntax-entry ?( ". 1" pascal-mode-syntax-table)  
+  (modify-syntax-entry ?) ". 4" pascal-mode-syntax-table)
+  (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table)
+  (modify-syntax-entry ?{ "<" pascal-mode-syntax-table)
+  (modify-syntax-entry ?} ">" pascal-mode-syntax-table)
+  (modify-syntax-entry ?+ "." pascal-mode-syntax-table)
+  (modify-syntax-entry ?- "." pascal-mode-syntax-table)
+  (modify-syntax-entry ?= "." pascal-mode-syntax-table)
+  (modify-syntax-entry ?% "." pascal-mode-syntax-table)
+  (modify-syntax-entry ?< "." pascal-mode-syntax-table)
+  (modify-syntax-entry ?> "." pascal-mode-syntax-table)
+  (modify-syntax-entry ?& "." pascal-mode-syntax-table)
+  (modify-syntax-entry ?| "." pascal-mode-syntax-table)
+  (modify-syntax-entry ?_ "w" pascal-mode-syntax-table)
+  (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table))
+
+(defconst pascal-indent-level 3
+  "*Indentation of Pascal statements with respect to containing block.")
+(defconst pascal-continued-expr 1
+  "*Indentation of line that is a continued expression.")
+(defconst pascal-label-offset -1
+  "*Offset of Pascal label lines, case statements and record lines.
+This is relative to usual indentation.")
+(defconst pascal-case-offset 2
+  "*Indentation after case statements.")
+(defconst pascal-vardecl-indent 15
+  "*Indentation (from the beginning of line to `:' of the declaration.")
+(defconst pascal-typedecl-indent 10
+  "*Indentation (from the beginning of line to `=' of the declaration.")
+(defconst pascal-auto-newline nil
+  "*Non-nil means automatically newline after semicolons and `end'.")
+(defconst pascal-tab-always-indent t
+  "*Non-nil means TAB in Pascal mode should always reindent the current line.
+It does so regardless of where in the line point is
+when the TAB command is used.")
+(defconst pascal-auto-endcomments t
+  "*Non-nil means make a comment { ... } after the end for a case or function.
+The name of the function or case is put between the braces.")
+
+;;;###autoload
+(defun pascal-mode ()
+  "Major mode for editing Pascal code.
+Tab indents for Pascal code.
+Delete converts tabs to spaces as it moves back.
+\\{pascal-mode-map}
+Variables controlling indentation style:
+ pascal-tab-always-indent (default t)
+    Non-nil means TAB in Pascal mode should always reindent the current line,
+    regardless of where in the line point is when the TAB command is used.
+ pascal-auto-newline (default nil)
+    Non-nil means automatically newline after semicolons and the punctation
+    mark after an end.
+ pascal-auto-endcomments (default t)
+    Non-nil means automatically set name of function or `case' in braces after
+    after the `end' if this end ends a function or a case block.
+ pascal-indent-level (default 3)
+    Indentation of Pascal statements within surrounding block.
+ pascal-continued-expr (default 1)
+    Indentation of a line that is a continued expression.
+ pascal-typedecl-indent (default 10)
+    Indentation to the `=' in type declarations. (Or constant declarations.)
+ pascal-vardecl-indent (default 20)
+    Indentation to the `:' in var declarations.
+ pascal-label-offset (default -1)
+    Extra indentation for line that is a label, case statement or part of
+    a record block.
+ pascal-case-offset (default 2)
+    Extra indent to the `:' in case statements.
+
+The only auto indention this mode doesn't fully support is if there is a
+case within a type declaration.  However, this is seldom used.
+
+When typing text, you should not worry about to get right indentions, they
+will be set when you hit return. The mode will also automatically delete the
+whitespaces between `*' and `)' when ending a starcomment.
+
+Turning on Pascal mode calls the value of the variable pascal-mode-hook with
+no args, if that value is non-nil."
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map pascal-mode-map)
+  (setq major-mode 'pascal-mode)
+  (setq mode-name "Pascal")
+  (setq local-abbrev-table pascal-mode-abbrev-table)
+  (set-syntax-table pascal-mode-syntax-table)
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function 'pascal-indent-line)
+  (setq comment-indent-hook 'pascal-indent-within-comment)
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments t)
+  (make-local-variable 'case-fold-search)
+  (setq case-fold-search t)
+  (run-hooks 'pascal-mode-hook))
+
+;;;
+;;;  Electric functions
+;;;
+
+(defun electric-pascal-terminate-line ()
+  "Terminate line and indent next line."
+  (interactive)
+  (save-excursion
+    (beginning-of-line)
+    (skip-chars-forward " \t")
+    (if (looking-at "until\\b\\|end\\(\\b\\|;\\|\\.\\)\\|begin\\b\\|repeat\\b\\|else\\b")
+	(pascal-indent-line)))
+  (newline)
+  (pascal-indent-line)
+  ;; Maybe we should set some endcomments
+  (if pascal-auto-endcomments
+      (pascal-set-auto-comments))
+  ;; Check if we shall indent inside comment
+  (let ((setstar nil))
+    (save-excursion
+      (forward-line -1)
+      (skip-chars-forward " \t")
+      (cond ((looking-at "\\*[ \t]*)")
+	     ;; Delete region between `*' and `)' if there is only whitespaces.
+	     (forward-char 1)
+	     (pascal-delete-whitespaces))
+	    ((and (looking-at "(\\*\\|\\*[^)]")
+		  (not (save-excursion
+			 (search-forward "*)" (pascal-get-end-of-line) t))))
+	     (setq setstar t))))
+    ;; If last line was a star comment line then this one shall be too.
+    (if setstar
+	(progn
+	  (insert "*")
+	  (pascal-indent-command))
+      (pascal-indent-line))))
+
+(defun electric-pascal-semi ()
+  "Insert ; character and correct this line's indention."
+  (interactive)
+  (insert last-command-char)
+  (save-excursion
+    (beginning-of-line)
+    (pascal-indent-line))
+  (if pascal-auto-newline
+      (electric-pascal-terminate-line)))
+
+(defun electric-pascal-dot ()
+  "Insert a period and correct this line's indention."
+  (interactive)
+  (insert last-command-char)
+  (save-excursion
+    (beginning-of-line)
+    (pascal-indent-line))
+  (if pascal-auto-newline
+      (electric-pascal-terminate-line)))
+
+(defun electric-pascal-colon ()
+  "Insert : and do all indentions except line indent on this line."
+  (interactive)
+  (insert last-command-char)
+  ;; Do nothing of within string.
+  (if (not (pascal-within-string))
+      (progn
+	(if (save-excursion
+	      (backward-char 2)
+	      (looking-at "[0-9]"))
+	    (save-excursion
+	      (beginning-of-line)
+	      (pascal-indent-line)))
+	(let ((pascal-tab-always-indent nil))
+	  (pascal-indent-command)))))
+  
+(defun electric-pascal-equal ()
+  "Insert = and do indention if within type declaration."
+  (interactive)
+  (insert last-command-char)
+  (if (eq (nth 1 (pascal-calculate-indent t)) 'decl)
+      (let ((pascal-tab-always-indent nil))
+	(pascal-indent-command))))
+
+(defun electric-pascal-tab ()
+  "Function called when tab is pressed."
+  (interactive)
+  ;; Do nothing if within a string.
+  (if (not (pascal-within-string))
+      ;; If pascal-tab-always-indent is set then indent the beginning of
+      ;; the line.
+      (progn
+	(if pascal-tab-always-indent
+	    (save-excursion
+	      (beginning-of-line)
+	      (pascal-indent-line)))
+	(pascal-indent-command))))
+
+;;;
+;;; Interactive functions
+;;;
+(defun pascal-insert-block ()
+  "Insert begin ... end; block in the code with right indents."
+  (interactive)
+  (pascal-indent-line)
+  (insert "begin")
+  (electric-pascal-terminate-line)
+  (save-excursion
+    (electric-pascal-terminate-line)
+    (insert "end;")
+    (beginning-of-line)
+    (pascal-indent-line)))
+
+(defun pascal-star-comment ()
+  "Insert star comment in the code."
+  (interactive)
+  (pascal-indent-line)
+  (insert "(*")
+  (electric-pascal-terminate-line)
+  (save-excursion
+    (electric-pascal-terminate-line)
+    (pascal-delete-whitespaces)
+    (insert ")")))
+
+(defun pascal-mark-function ()
+  "Mark the current pascal function (or procedure).
+Put the mark at the end of the function, and point at the beginning."
+  (interactive)
+  (push-mark (point))
+  (pascal-forward-to-end-of-function)
+  (push-mark (point))
+  (pascal-backward-to-beginning-of-function)
+  (zmacs-activate-region))
+
+(defun pascal-comment-area (start end)
+  "Put the current region in a comment.
+The comments that are in this area are
+be changed so that `*)' becomes `!(*' and `}' becomes `!{'. These will
+however be turned back to normal when the area is uncommented by pressing
+\\[pascal-uncomment-area].
+The commented area starts with: `{---\\/---EXCLUDED---\\/---' , and ends with:
+` ---/\\---EXCLUDED---/\\---}'. If these texts are changed, uncomment-area
+will not be able to recognize them."
+  (interactive "r")
+  (save-excursion
+    ;; Insert start and endcomments
+    (goto-char end)
+    (if (and (save-excursion (skip-chars-forward " \t") (eolp))
+	     (not (save-excursion (skip-chars-backward " \t") (bolp))))
+	(forward-line 1)
+      (beginning-of-line))
+    (insert " ---/\\---EXCLUDED---/\\---}")
+    (setq end (point))
+    (newline)
+    (goto-char start)
+    (beginning-of-line)
+    (insert "{---\\/---EXCLUDED---\\/--- ")
+    (newline)
+    ;; Replace end-comments within commented area
+    (goto-char end)
+    (save-excursion
+      (while (re-search-backward "\\*)" start t)
+	(replace-match "!(*" t t)))
+    (save-excursion
+      (while (re-search-backward "}" start t)
+	(replace-match "!{" t t)))))
+
+(defun pascal-uncomment-area ()
+  "Uncomment a commented area.
+Change all deformed comments in this area back to normal.
+This function does nothing if the pointer is not in a commented
+area.  See also `pascal-comment-area'."
+  (interactive)
+  (save-excursion
+    (let ((start (point))
+	  (end (point)))
+      ;; Find the boundaries of the comment
+      (save-excursion
+	(setq start (progn (search-backward "{---\\/---EXCLUDED---\\/--" nil t)
+			   (point)))
+	(setq end (progn (search-forward "---/\\---EXCLUDED---/\\---}" nil t)
+			 (point))))
+      ;; Check if we're really inside a comment
+      (if (or (equal start (point)) (<= end (point)))
+	  (message "Not standing within commented area.")
+	(progn
+	  ;; Remove endcomment
+	  (goto-char end)
+	  (beginning-of-line)
+	  (let ((pos (point)))
+	    (end-of-line)
+	    (delete-region pos (1+ (point))))
+	  ;; Change comments back to normal
+	  (save-excursion
+	    (while (re-search-backward "!{" start t)
+	      (replace-match "}" t t)))
+	  (save-excursion
+	    (while (re-search-backward "!(\\*" start t)
+	      (replace-match "*)" t t)))
+	  ;; Remove startcomment
+	  (goto-char start)
+	  (beginning-of-line)
+	  (let ((pos (point)))
+	    (end-of-line)
+	    (delete-region pos (1+ (point)))))))))
+
+(defun pascal-backward-to-beginning-of-function ()
+  "Move backwards to the beginning of this function or procedure."
+  (interactive)
+  ;; Check if this is a 
+  (if (save-excursion
+	(re-search-backward "\\<end" nil t)
+	(looking-at "end\\."))
+      (beginning-of-buffer)
+    (let ((nest-depth 0) (nest-max 0)
+	  (nest-noexit 1))
+      (beginning-of-line)
+      ;; First we find the max depth of the nesting
+      (save-excursion
+	(while (not (or (bobp) (looking-at "function\\b\\|procedure\\b")))
+	  (backward-sexp 1)
+	  (cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b")
+		 (setq nest-depth (1+ nest-depth)))
+		((looking-at "end\\(\\b\\|;\\|\\.\\)")
+		 (setq nest-depth (1- nest-depth))))
+	  (setq nest-max (max nest-depth nest-max))))
+      ;; Then we can start searching
+      (setq nest-depth 0)
+      (while (not (or (bobp) (and (looking-at "function\\b\\|procedure\\b")
+				  (zerop nest-noexit))))
+	(backward-sexp 1)
+	(cond ((looking-at "begin\\b\\|\\case\\b\\|record\\b")
+	       (setq nest-depth (1+ nest-depth)))
+	      ((looking-at "end\\(\\b\\|;\\|\\.\\)")
+	       (if (equal nest-depth nest-max)
+		   (setq nest-noexit (1+ nest-noexit)))
+	       (setq nest-depth (1- nest-depth)))
+	      ((looking-at "function\\b\\|procedure\\b")
+	       (setq nest-noexit (1- nest-noexit))))))))
+
+(defun pascal-forward-to-end-of-function ()
+  "Moves the point to the end of the function."
+  (interactive)
+  (if (not (looking-at "function\\b\\|procedure\\b"))
+      (pascal-backward-to-beginning-of-function))
+  (if (bobp)
+      (end-of-buffer)
+    (progn
+      (let ((nest-depth 0)
+	    (func-depth 1))
+	(while (not (or (and (zerop nest-depth) (zerop func-depth)) (eobp)))
+	  (forward-sexp 2)
+	  (if (not (eobp))
+	      (progn
+		(backward-sexp 1) ; Move to the beginning of the next sexp
+		(cond ((looking-at "begin\\b\\|case\\b\\|record\\b")
+		       (setq nest-depth (1+ nest-depth)))
+		      ((looking-at "end\\(\\b\\|;\\|\\.\\)")
+		       (setq nest-depth (1- nest-depth))
+		       (if (zerop nest-depth)
+			   (setq func-depth (1- func-depth))))
+		      ((looking-at "function\\b\\|procedure\\b")
+		       (setq func-depth (1+ func-depth)))))))
+	(end-of-line)))))
+
+(defun pascal-downcase-keywords ()
+  "Makes all Pascal keywords in the buffer lowercase."
+  (interactive)
+  (pascal-change-keywords 'downcase-word))
+
+(defun pascal-upcase-keywords ()
+  "Makes all Pascal keywords in the buffer uppercase."
+  (interactive)
+  (pascal-change-keywords 'upcase-word))
+
+(defun pascal-capitalize-keywords ()
+  "Makes all Pascal keywords in the buffer uppercase."
+  (interactive)
+  (pascal-change-keywords 'capitalize-word))
+
+(defun pascal-change-keywords (change-word)
+  "Change the keywords according to argument."
+  (save-excursion
+    (beginning-of-buffer)
+    (while (re-search-forward (mapconcat
+			       'downcase pascal-keywords "\\>\\|\\<") nil t)
+      (funcall change-word -1))))
+
+;;;
+;;; Other functions
+;;;
+(defun pascal-delete-whitespaces ()
+  "Deletes the whitespaces around the current point."
+  (interactive)
+  (let ((pos (progn (skip-chars-backward " \t") (point))))
+    (skip-chars-forward " \t")
+    (delete-region pos (point))))
+
+(defun pascal-get-beg-of-line ()
+  (save-excursion
+    (beginning-of-line)
+    (point)))
+
+(defun pascal-get-end-of-line ()
+  (save-excursion
+    (end-of-line)
+    (point)))
+  
+(defun pascal-within-string ()
+  "Return t if within string; nil otherwise."
+  (and (save-excursion (search-backward "\"" (pascal-get-beg-of-line) t))
+       (save-excursion (not (search-backward "\"" (pascal-get-beg-of-line) t 2)))))
+
+(defun pascal-check-if-within-comment ()
+  "If within a comment, return the correct indent.  Return nil otherwise."
+  (let ((comstart (point))
+	(comend (point)))
+    (save-excursion
+      (if (re-search-backward "(\\*\\|{" nil t)
+	  (setq comstart (point))
+	(setq comstart 0)))
+    (save-excursion
+      (if (re-search-backward "\\*)\\|}" nil t)
+	  (setq comend (point))
+	(setq comend 0)))
+    (if (< comend comstart)
+	(save-excursion
+	  (goto-char comstart)
+	  ;; Add 1 to indent if this is a starcomment
+	  (if (looking-at "(\\*")
+	      (1+ (current-column))
+	    (current-column)))
+      nil)))
+
+(defun pascal-set-auto-comments ()
+  "Put { case } or { FUNNAME } on this line if appropriate after `end'."
+  (save-excursion
+    (forward-line -1)
+    (skip-chars-forward " \t")
+    (if (and (looking-at "end\\(\>\\|;\\)")
+	     (not (save-excursion
+		    (end-of-line)
+		    (search-backward "}" (pascal-get-beg-of-line) t))))
+	(progn
+	  (if (eq (nth 1 (pascal-calculate-indent)) 'case)
+	      ;; This is a case block
+	      (progn
+		(end-of-line)
+		(pascal-delete-whitespaces)
+		(insert " { case }"))
+	    (let ((nest 1))
+	      ;; Check if this is the end of a function
+	      (save-excursion
+		(while (not (or (looking-at "function\\b\\|\\procedure\\b")
+				(bobp)))
+		  (backward-sexp 1)
+		  (cond ((looking-at "begin\\b\\|case\\b")
+			 (setq nest (1- nest)))
+			((looking-at "end\\(\\b\\|;\\|\\.\\)")
+			 (setq nest (1+ nest)))))
+		(if (bobp)
+		    (setq nest 1)))
+	      (if (zerop nest)
+		  (let ((last-command nil))
+		    ;; Find the function name and put it in braces
+		    (save-excursion
+		      (pascal-backward-to-beginning-of-function)
+		      (skip-chars-forward "^ \t")
+		      (skip-chars-forward " \t")
+		      (copy-region-as-kill (point)
+					   (save-excursion
+					     (skip-chars-forward "a-zA-Z0-9_")
+					     (point))))
+		    (end-of-line)
+		    (pascal-delete-whitespaces)
+		    (insert " { ")
+		    ;; We've filled up the kill ring, but hey, who cares?
+		    (yank) (rotate-yank-pointer 1)
+		    (insert " }")))))))))
+
+;;;
+;;; Indent functions and calculation of indent
+;;;	
+(defun pascal-indent-command ()
+  "Indent current line as Pascal code and/or indent within line."
+  ;; Call pascal-indent-line. This does nothing if we're not at the
+  ;; beginning of the line.
+  (pascal-indent-line)
+  (let ((indent (pascal-calculate-indent t))
+	(pos 0))
+    (save-excursion
+      (cond ((or (eq (nth 1 indent) 'case)
+		 (eq (nth 1 indent) 'record))
+	     ;; Indent for case and record blocks
+	     (beginning-of-line)
+	     (if (search-forward ":" (pascal-get-end-of-line) t)
+		 (progn
+		   ;; Indent before colon
+		   (backward-char 1)
+		   (pascal-delete-whitespaces)
+		   (indent-to (max (pascal-find-leading-case-colon)
+				   (1+ (current-column))))
+		   ;; Indent after colon
+		   (forward-char 1)
+		   (pascal-delete-whitespaces)
+		   (indent-to (1+ (current-column))))
+	       ;; Indent if there is no colon
+	       (progn
+		 (beginning-of-line)
+		 (skip-chars-forward " \t")
+		 (if (not (eolp))
+		     (progn
+		       (skip-chars-forward "0-9a-zA-Z\"\'_;")
+		       (pascal-delete-whitespaces)
+		       (indent-to (max (pascal-find-leading-case-colon)
+				       (1+ (current-column)))))))))
+	    ((eq (nth 1 indent) 'decl)
+	     ;; Indent for declarations
+	     (let ((posii (pascal-get-beg-of-line)))
+	       (re-search-backward "\\<\\(var\\|type\\|const\\|label\\)\\>"
+				   nil t)
+	       (cond ((looking-at "var\\b")
+		      (pascal-declindent-middle-of-line
+		       ":" posii pascal-vardecl-indent))
+		     ((looking-at "type\\b\\|const\\b")
+		      (pascal-declindent-middle-of-line
+		       "=" posii pascal-typedecl-indent)))))
+	    ((eq (nth 1 indent) 'function)
+	     ;; Indent for parameterlist
+	     ;; Done twice in case something has changed
+	     (pascal-indent-parameter-list)
+	     (pascal-indent-parameter-list))))	     
+    ;; Go to the end of a line if rest of line contains only whitespaces
+    (if (save-excursion (skip-chars-forward " \t") (eolp))
+	(end-of-line))))
+
+(defun pascal-indent-line ()
+  "Indent current line as Pascal code."
+  (let ((indent (list 0 nil))
+	(comindent 0)
+	beg (point))
+    (save-excursion
+      (beginning-of-line)
+      (setq indent (pascal-calculate-indent)))
+    ;; If we are inside a comment, do special indent.
+    (if (setq comindent (pascal-check-if-within-comment))
+	(pascal-indent-within-comment comindent)
+      ;; Skip the rest if we're not standing on the beginning of a line.
+      (if (save-excursion (skip-chars-backward " \t") (bolp))
+	  (progn
+	    (beginning-of-line)
+	    (pascal-delete-whitespaces)
+	    ;; When to skip the ekstra indent:
+	    ;; If we are standing at end or until.
+	    ;; If we are in an if statement and standing at else,
+	    ;;  begin or repeat
+	    ;; If we are in a with, while or for statement and standing
+	    ;;  at begin or end.
+	    (cond ((or (or (looking-at "end\\b\\|until\\b")
+			   (not (nth 1 indent)))
+		       (and (eq (nth 1 indent) 'if)
+			    (looking-at "begin\\b\\|\\repeat\\b\\|else\\b"))
+		       (and (eq (nth 1 indent) 'whilewith)
+			    (looking-at "begin\\b\\|\\repeat\\b")))
+		   (indent-to (car indent)))
+		  ;; Continued expression
+		  ((eq (nth 1 indent) 'contexp)
+		   (indent-to (+ (car indent) pascal-continued-expr)))
+		  ;; If this is a part of a case or record block,
+		  ;; then modify the indent level.
+		  ((or (eq (nth 1 indent) 'case)
+		       (eq (nth 1 indent) 'record))
+		   (indent-to (+ (car indent) pascal-indent-level
+				 pascal-label-offset)))
+		  ;; If this is a label - don't indent.
+		  ((looking-at "[0-9]*:")
+		   (skip-chars-forward "0-9:")
+		   (pascal-delete-whitespaces)
+		   (indent-to (+ (car indent) pascal-indent-level)))
+		  ;; If this is insde a parameter list, do special indent
+		  ((eq (nth 1 indent) 'function)
+		   (pascal-indent-parameter-list))
+		  ;; All other indents are set normaly.
+		  (t
+		   (indent-to (+ (car indent) pascal-indent-level)))))))))
+    
+(defun pascal-calculate-indent (&optional arg)
+  "Search backward in code to find the right indent level.
+Return a list containing:
+1. Indent level
+2. The indent keyword (begin, case etc.), or nil if backtracking failed.
+If arg is non-nil, we do not search for continued expressions."
+  (let ((pascal-nest-depth 1)
+	(oldpos (save-excursion (forward-line -1) (end-of-line) (point)))
+	(samepos (point)) (if-is-set t)
+	(return-struct (list 0 nil)) (pos 0)
+	(contexpr nil) (after-contexpr (not arg))
+	(case-fold-search t))
+    (save-excursion
+      (while (and (not (zerop pascal-nest-depth))
+		  (not (bobp)))
+	(progn
+	  (backward-sexp 1)
+	  (if (save-excursion
+		(setq pos (point))
+		(end-of-line)
+		(search-backward ";" pos t))
+	      (setq if-is-set nil
+		    after-contexpr nil))
+	  (if (looking-at "then\\b\\|end\\b\\|else\\b\\|do\\b")
+	      (setq after-contexpr nil))
+
+	  (cond ((looking-at "begin\\b\\|case\\b\\|record\\b\\|repeat\\b")
+		 (setq pascal-nest-depth (1- pascal-nest-depth)))
+		;;
+		;; END | UNTIL
+		((looking-at "end\\(\\b\\|;\\|\\.\\)\\|until\\b")
+		 (setq if-is-set nil)
+		 (if after-contexpr
+		     (setq pascal-nest-depth 0
+			   contexpr t)
+		   (setq pascal-nest-depth (1+ pascal-nest-depth))))
+		;;
+		;; IF | ELSE | WITH | WHILE | FOR
+		;; LABEL |  CONST | TYPE | FUNCTION | PROCEDURE
+		((or (and (looking-at "if\\b\\|else\\b\\|with\\b\\|while\\b\\|for\\b")
+			  if-is-set)
+		     (looking-at "label\\b\\|const\\b\\|type\\b\\|function\\b\\|procedure\\b"))
+		 (setq pascal-nest-depth 0))
+		;;
+		;; VAR
+		((looking-at "var\\b")
+		 ;; A `var' can be in a declaration part or parameter part
+		 (let ((stpos 0) (edpos 0))
+		   (save-excursion
+		     (if (not (re-search-backward
+			       "\\<\\(function\\|procedure\\)\\>" nil t))
+			 (beginning-of-buffer))
+		     (setq stpos (save-excursion
+				   (search-forward "(" nil t) (point)))
+		     (setq edpos (save-excursion
+				   (search-forward ")" nil t) (point))))
+		   (cond ((or (= stpos edpos) (< samepos stpos)
+			      (and (> (point) edpos) (> edpos stpos)))
+			  ;; This is really a declaration block!!
+			  nil)
+			 ((and (>= samepos stpos) (or (< samepos edpos)
+						      (> stpos edpos)))
+			  ;; Hmm... part of a parameter
+			  (re-search-backward
+			   "\\<\\(function\\|procedure\\)\\>" nil t))
+			 (t
+			  ;; This is just after a parameter declaration
+			  (forward-char 1)))
+		   ;; We'll quit anyway
+		   (setq pascal-nest-depth 0)))
+		;;
+		;; CONTINUED EXPRESSIONS
+		(after-contexpr
+		 (save-excursion
+		   ;; First, we have to be at the begining of a line
+		   (if (and (progn (skip-chars-backward " \t") (bolp))
+			    ;; Blank lines don't count
+			    (not (progn (skip-chars-forward " \t") (eolp)))
+			    ;; But nonblank without ';' do
+			    (not (search-forward ";" (pascal-get-end-of-line) t)))
+		       (save-excursion
+			 (forward-line -1)
+			 (end-of-line)
+			 (backward-sexp 1)
+			 (if (or (looking-at "\\(do\\|then\\|of\\\|begin\\|repeat\\|else\\)\\>")
+				 (progn
+				   (skip-chars-forward "^; " (pascal-get-end-of-line))
+				   (equal (char-to-string (following-char))
+					  ";")))
+			     (setq pascal-nest-depth 0))
+			 (setq contexpr t)))))
+		)))
+      (cond (contexpr
+	     (setq return-struct (list (pascal-lstart-col) 'contexp)))
+	    ((looking-at "begin\\b")
+	     (setq return-struct (list (pascal-lstart-col) 'begin)))
+	    ((looking-at "else\\b")
+	     (setq return-struct (list (save-excursion
+					 (re-search-backward "if\\b" nil t)
+					 (pascal-lstart-col)) 'if))
+	     ;; Indent line in case this is a multiple if
+	     (beginning-of-line)
+	     (pascal-delete-whitespaces)
+	     (indent-to (car return-struct)))
+	    ((looking-at "if\\b")
+	     (if (save-excursion
+		   (narrow-to-region (pascal-get-beg-of-line) (point))
+		   (backward-sexp 1)
+		   (widen)
+		   (looking-at "else\\b"))
+		 ;; Indent line if this is a multiple if
+		 (progn
+		   (beginning-of-line)
+		   (pascal-delete-whitespaces)
+		   (indent-to (save-excursion
+				(re-search-backward "if\\b" nil t)
+				(pascal-lstart-col)))))
+	     ;; This could be a continued expression
+	     (if (and after-contexpr
+		      (not (save-excursion (re-search-forward
+					    "then\\b" (pascal-get-end-of-line) t))))
+		 (setq return-struct (list (pascal-lstart-col) 'contexp))
+	       (setq return-struct (list (pascal-lstart-col) 'if))))
+	    ((looking-at "repeat\\b")
+	     (setq return-struct (list (pascal-lstart-col) 'repeat)))
+	    ((looking-at "case\\b")
+	     (setq return-struct (list (current-column) 'case)))
+	    ((looking-at "record\\b")
+	     (setq return-struct (list (current-column) 'record)))
+	    ((looking-at "while\\b\\|with\\b\\|for\\b")
+	     ;; This could ba a continued expression
+	     (if (and after-contexpr
+		      (not (save-excursion (re-search-forward
+					    "do\\b" (pascal-get-end-of-line) t))))
+		 (setq return-struct (list (pascal-lstart-col) 'contexp))
+	       (setq return-struct (list (current-column) 'whilewith))))
+	    ((looking-at "procedure\\b\\|function\\b")
+	     ;; Make sure that this is a function with parameters, and
+	     ;; that we are actually standing inside the paranthesis.
+	     (let ((spos (save-excursion
+			   (search-forward "(" samepos t) (point)))
+		   (epos (save-excursion
+			   (search-forward ")" samepos t) (point))))
+	       (if (and (>= samepos spos) (or (< samepos epos)
+					      (> spos epos)))
+		   (setq return-struct (list 0 'function))
+		 (setq return-struct (list 0 nil)))))
+	    ((looking-at "var\\b\\|label\\b\\|const\\b\\|type\\b")
+	     ;; Are we really in the declaration part?(Check for blank lines)
+	     (if (< oldpos (point))
+		 (setq return-struct (list 0 'decl))
+	       (if (save-excursion
+		     (not (re-search-forward "^[ \t]*$" oldpos t)))
+		   (setq return-struct (list 0 'decl))
+		 (setq return-struct (list 0 nil)))))
+	    (t
+	     (setq return-struct (list 0 nil))))
+      return-struct)))
+
+(defun pascal-lstart-col ()
+  "Return the column of the beginning of the first command on the line."
+  (save-excursion
+    (beginning-of-line)
+    (skip-chars-forward ":0-9")
+    (skip-chars-forward " \t")
+    (current-column)))
+
+(defun pascal-indent-parameter-list ()
+  "Indent this line as part of a parameter list in a function."
+  (let ((indents (pascal-get-highest-indents-in-parameterlist))
+	(pos 0))
+    (if (not (progn (beginning-of-line)
+		    (search-forward "(" (pascal-get-end-of-line) t)))
+	(progn (beginning-of-line)
+  	       (skip-chars-forward " \t")))
+    ;; Indent region in front of var
+    (skip-chars-forward " \t")
+    (pascal-delete-whitespaces)
+    (indent-to (nth 0 indents))
+    (if (looking-at "var\\b")
+	(forward-char 3))
+    ;; Indent parameternames
+    (pascal-delete-whitespaces)
+    (indent-to (nth 1 indents))
+    (if (not (save-excursion (skip-chars-forward " \t") (eolp)))
+	(progn
+	  ;; Indent colon
+	  (if (search-forward ":" (pascal-get-end-of-line) t)
+	      (backward-char 1)
+	    (end-of-line))
+	  (pascal-delete-whitespaces)
+	  (indent-to (nth 2 indents))
+	  ;; Indent after colon
+	  (if (equal (following-char) ?:)
+	      (progn
+		(forward-char 1)
+		(pascal-delete-whitespaces)
+		(indent-to (+ 2 (nth 2 indents)))))))))
+
+;; Get the indents to use in a parameterlist.
+;; Returns:
+;; 1. Indent to the beginning of the line.
+;; 2. Indent to the beginning of the parameter names.
+;; 3. Indent to the right colon position."
+(defun pascal-get-highest-indents-in-parameterlist ()
+  (save-excursion
+    (let ((start (progn
+		   (re-search-backward
+		    "\\<\\(function\\|procedure\\)\\>" nil t)
+		   (search-forward "(")
+		   (current-column)))
+	  (arglength 0) (vardecl nil) (done nil))
+      (while (not (or done (eobp)))
+	(beginning-of-line)
+	(if (save-excursion
+	      (re-search-forward "\\<var\\>" (pascal-get-end-of-line) t))
+	      (setq vardecl t))
+	(if (not (re-search-forward ":" (pascal-get-end-of-line) t))
+	    (setq done t))
+	(skip-chars-backward ": \t")
+	(setq arglength (max arglength (current-column)))
+	(forward-line 1))
+      (if vardecl
+	  (list start (+ start 4) (1+ arglength))
+	(list start start (1+ arglength))))))
+
+(defun pascal-declindent-middle-of-line (declkey endpos defaultindent)
+  "Indent declaration line."
+  (let ((decindent 0))
+    (if (search-forward declkey endpos t)
+	(setq decindent (1- (current-column)))
+      (setq decindent defaultindent))
+    (goto-char endpos)
+    (end-of-line)
+    (if (save-excursion (search-backward declkey endpos t))
+	(progn (search-backward declkey) (skip-chars-backward " \t"))
+      (skip-chars-backward " \t"))
+    (pascal-delete-whitespaces)
+    (indent-to (max decindent (1+ (current-column))))
+    ;; Indent after `declkey'
+    (if (looking-at declkey)
+	(progn
+	  (forward-char 1)
+	  (pascal-delete-whitespaces)
+	  (indent-to (1+ (current-column)))))))
+  
+(defun pascal-indent-within-comment (indent)
+  "Indent comments and/or indent text within comment."
+  (progn
+    ;; If we are at the beginning of the line, then we indent this line.
+    (if (save-excursion (skip-chars-backward " \t") (bolp))
+	(progn
+	  (beginning-of-line)
+	  (pascal-delete-whitespaces)
+	  (indent-to indent))
+      ;; Do nothing if we're not in a star comment.
+      (if (save-excursion
+	    (beginning-of-line)
+	    (skip-chars-forward " \t")
+	    (looking-at "\\*\\|(\\*"))
+	  (save-excursion
+	    (beginning-of-line)
+	    (search-forward "*")
+	    (pascal-delete-whitespaces)
+	    (indent-to (+ (current-column) 2)))))))
+
+(defun pascal-find-leading-case-colon ()
+  "Return hpos of first colon after the case-of or record line.
+If there's no such line, use the place where it ought to be."
+  (let ((pos (save-excursion
+	       (beginning-of-line)
+	       (skip-chars-forward " \t")
+	       (point))))
+    (save-excursion
+      (re-search-backward "\\<\\(case\\|record\\)\\>")
+      (forward-line 1)
+      (skip-chars-forward " \t")
+      (if (not (eq pos (point)))
+	  (progn
+	    (search-forward ":" (pascal-get-end-of-line) t)
+	    (1- (current-column)))
+	(+ (current-column) pascal-case-offset)))))
+
+(provide 'pascal)
+
+;; pascal.el ends here.

lisp/thingatpt.el

@@ -0,0 +1,206 @@
+;;; thingatpt.el --- Get the `thing' at point
+
+;; Copyright (C) 1991,1992,1993 Free Software Foundation, Inc.
+
+;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
+;; Keywords: extensions
+;; Created: Thu Mar 28 13:48:23 1991
+;; Version: $Revision: 1.16 $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;;; Commentary:
+;;
+;; This file provides routines for getting the `thing' at the location of
+;; point, whatever that `thing' happens to be.  The `thing' is defined by
+;; it's beginning and end positions in the buffer.
+;;
+;; The function bounds-of-thing-at-point finds the beginning and end
+;; positions by moving first forward to the end of the `thing', and then
+;; backwards to the beginning.  By default, it uses the corresponding
+;; forward-`thing' operator (eg. forward-word, forward-line).
+;;
+;; Special cases are allowed for using properties associated with the named
+;; `thing': 
+;;
+;;   forward-op		Function to call to skip forward over a `thing' (or
+;;                      with a negative argument, backward).
+;;                      
+;;   beginning-op	Function to call to skip to the beginning of a `thing'.
+;;   end-op		Function to call to skip to the end of a `thing'.
+;;
+;; Reliance on existing operators means that many `things' can be accessed
+;; without further code:  eg.
+;;     (thing-at-point 'line)
+;;     (thing-at-point 'page)
+
+;;; Code:
+
+(provide 'thingatpt)
+
+;;=== Version =============================================================
+
+(defconst thing@pt-version (substring "$Revision: 1.16 $" 11 -2)
+  "The revision number of thing@pt (as string).  The complete RCS id is:
+
+  $Id: thing@pt.el,v 1.16 1993/09/30 23:54:56 mike Exp $")
+
+;;=== Basic movement ======================================================
+
+;;;###autoload
+(defun forward-thing (THING &optional N)
+  "Move forward to the end of the next THING."
+  (let ((forward-op (or (get THING 'forward-op)
+			(intern-soft (format "forward-%s" THING)))))
+    (if (fboundp forward-op)
+	(funcall forward-op (or N 1))
+      (error "Can't determine how to move over %ss" THING))))
+
+;;=== General routines ====================================================
+
+;;;###autoload
+(defun bounds-of-thing-at-point (THING)
+  "Determine the start and end buffer locations for the THING at point,
+where THING is an entity for which there is a either a corresponding
+forward-THING operation, or corresponding beginning-of-THING and
+end-of-THING operations, eg. 'word, 'sentence, 'defun.
+  Return a cons cell '(start . end) giving the start and end positions."
+  (let ((orig (point)))
+    (condition-case nil
+	(save-excursion
+	  (let ((end (progn 
+		       (funcall 
+			(or (get THING 'end-op) 
+			    (function (lambda () (forward-thing THING 1)))))
+		       (point)))
+		(beg (progn 
+		       (funcall 
+			(or (get THING 'beginning-op) 
+			    (function (lambda () (forward-thing THING -1)))))
+		       (point))))
+	    (if (and beg end (<= beg orig) (< orig end))
+		(cons beg end))))
+      (error nil))))
+
+;;;###autoload
+(defun thing-at-point (THING)
+  "Return the THING at point, where THING is an entity defined by
+bounds-of-thing-at-point."
+  (let ((bounds (bounds-of-thing-at-point THING)))
+    (if bounds 
+	(buffer-substring (car bounds) (cdr bounds)))))
+
+;;=== Go to beginning/end =================================================
+
+(defun beginning-of-thing (THING)
+  (let ((bounds (bounds-of-thing-at-point THING)))
+    (or bounds (error "No %s here" THING))
+    (goto-char (car bounds))))
+
+(defun end-of-thing (THING)
+  (let ((bounds (bounds-of-thing-at-point THING)))
+    (or bounds (error "No %s here" THING))
+    (goto-char (cdr bounds))))
+
+;;=== Special cases =======================================================
+
+;;--- Sexps ---
+
+(defun in-string-p ()
+  (let ((orig (point)))
+    (save-excursion
+      (beginning-of-defun)
+      (nth 3 (parse-partial-sexp (point) orig)))))
+
+(defun end-of-sexp ()
+  (let ((char-syntax (char-syntax (char-after (point)))))
+    (if (or (eq char-syntax ?\))
+	    (and (eq char-syntax ?\") (in-string-p)))
+	(forward-char 1)
+      (forward-sexp 1))))
+
+(put 'sexp 'end-op 'end-of-sexp)
+
+;;--- Lists ---
+
+(put 'list 'end-op (function (lambda () (up-list 1))))
+(put 'list 'beginning-op 'backward-sexp)
+
+;;--- Filenames ---
+
+(defvar file-name-chars "~/A-Za-z0-9---_.${}#%,"
+  "Characters allowable in filenames.")
+
+(put 'filename 'end-op    
+     (function (lambda () (skip-chars-forward file-name-chars))))
+(put 'filename 'beginning-op
+     (function (lambda () (skip-chars-backward file-name-chars (point-min)))))
+
+;;--- Whitespace ---
+
+(defun forward-whitespace (ARG)
+  (interactive "p")
+  (if (natnump ARG) 
+      (re-search-forward "[ \t]+\\|\n" nil nil ARG)
+    (while (< ARG 0)
+      (if (re-search-backward "[ \t]+\\|\n" nil nil)
+	  (or (eq (char-after (match-beginning 0)) 10)
+	      (skip-chars-backward " \t")))
+      (setq ARG (1+ ARG)))))
+
+;;--- Buffer ---
+
+(put 'buffer 'end-op 'end-of-buffer)
+(put 'buffer 'beginning-op 'beginning-of-buffer)
+
+;;--- Symbols ---
+
+(defun forward-symbol (ARG)
+  (interactive "p")
+  (if (natnump ARG) 
+      (re-search-forward "\\(\\sw\\|\\s_\\)+" nil nil ARG)
+    (while (< ARG 0)
+      (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil nil)
+	  (skip-syntax-backward "w_"))
+      (setq ARG (1+ ARG)))))
+
+;;=== Aliases =============================================================
+
+(defun word-at-point () (thing-at-point 'word))
+(defun sentence-at-point () (thing-at-point 'sentence))
+
+(defun read-from-whole-string (STR)
+  "Read a lisp expression from STR, signalling an error if the entire string
+was not used."
+  (let* ((read-data (read-from-string STR))
+	 (more-left 
+	  (condition-case nil
+	      (progn (read-from-string (substring STR (cdr read-data)))
+		     t)
+	    (end-of-file nil))))
+    (if more-left
+	(error "Can't read whole string")
+      (car read-data))))
+
+(defun form-at-point (&optional THING PRED) 
+  (let ((sexp (condition-case nil 
+		  (read-from-whole-string (thing-at-point (or THING 'sexp)))
+		(error nil))))
+    (if (or (not PRED) (funcall PRED sexp)) sexp)))
+
+(defun sexp-at-point ()   (form-at-point 'sexp))
+(defun symbol-at-point () (form-at-point 'sexp 'symbolp))
+(defun number-at-point () (form-at-point 'sexp 'numberp))
+(defun list-at-point ()   (form-at-point 'list 'listp))
+
+;; thingatpt.el ends here.