Commits

Anonymous committed 7a30703

First release of fsf-compatibility packages

Comments (0)

Files changed (7)

+1998-03-25  SL Baur  <steve@altair.xemacs.org>
+
+	* Created.
+# Makefile for XEmacs development lisp code
+
+# This file is part of XEmacs.
+
+# XEmacs 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.
+
+# XEmacs 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 XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# This XEmacs package contains independent single file lisp packages
+
+VERSION = 1.0
+AUTHOR_VERSION =
+MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
+PACKAGE = fsf-compat
+PKG_TYPE = single-file
+REQUIRES = 
+CATEGORY = libs
+
+EXTRA_SOURCES = README
+
+ELCS = overlay.elc thingatpt.elc timer.elc
+
+include ../../XEmacs.rules
+
+all:: $(ELCS) auto-autoloads.elc # custom-load.elc
+
+srckit: srckit-std
+
+binkit: binkit-sourceonly
+The stuff provided in this package is done to ease porting of non-portable
+Emacs lisp code.  Please do not use the stuff here in new code.
+
+- The XEmacs Development Team.
+;;; overlay.el --- overlay support.
+
+;; Copyright (C) 1997 Free Software Foundation, Inc.
+
+;; Author: Joe Nuspl <nuspl@sequent.com>
+;; Maintainer: XEmacs Development Team (in <hniksic@srce.hr> incarnation)
+;; Keywords: internal
+
+;; This file is part of XEmacs.
+
+;; XEmacs 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.
+
+;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the 
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; Unlike the text-properties interface, these functions are in fact
+;; totally useless in XEmacs.  They are a more or less straightforward
+;; interface to the much better extent API, provided exclusively for
+;; GNU Emacs compatibility.  If you notice an incompatibility not
+;; mentioned below, be sure to mention it.  Anyways, you should really
+;; not use this.
+
+;; Known incompatibilities with the FSF interface:
+
+;; 1. There is not an `overlay' type.  Any extent with non-nil
+;;    'overlay property is considered an "overlay".
+;;
+;; 2. Some features of FSF overlays have not been implemented in
+;;    extents (or are unneeded).  Specifically, those are the
+;;    following special properties: window, insert-in-front-hooks,
+;;    insert-behind-hooks, and modification-hooks.  Some of these will
+;;    probably be implemented for extents in the future.
+;;
+;; 3. In FSF, beginning and end of an overlay are markers, which means
+;;    that you can use `insert-before-markers' to change insertion
+;;    property of overlay.  It will not work in this emulation, and we
+;;    have no plans of providing it.
+;;
+;; 4. The `overlays-in' and `overlays-at' functions in some cases
+;;    don't work as they should.  To be fixed RSN.
+;;
+;; 5. Finally, setting or modification of overlay properties specific
+;;    to extents will have unusual results.  While (overlay-put
+;;    overlay 'start-open t) does nothing under FSF, it has a definite
+;;    effect under XEmacs.  This is solved by simply avoiding such
+;;    names (see `set-extent-property' for a list).
+
+;; Some functions were broken; fixed-up by Hrvoje Niksic, June 1997.
+
+
+;;; Code:
+
+(defun overlayp (object)
+  "Return t if OBJECT is an overlay."
+  (and (extentp object)
+       (extent-property object 'overlay)))
+
+(defun make-overlay (beg end &optional buffer front-advance rear-advance)
+  "Create a new overlay with range BEG to END in BUFFER.
+If omitted, BUFFER defaults to the current buffer.
+BEG and END may be integers or markers.
+The fourth arg FRONT-ADVANCE, if non-nil, makes the
+front delimiter advance when text is inserted there.
+The fifth arg REAR-ADVANCE, if non-nil, makes the
+rear delimiter advance when text is inserted there."
+  (if (null buffer)
+      (setq buffer (current-buffer))
+    (check-argument-type 'bufferp buffer))
+  (when (> beg end)
+    (setq beg (prog1 end (setq end beg))))
+
+  (let ((overlay (make-extent beg end buffer)))
+    (set-extent-property overlay 'overlay t)
+    (if front-advance
+	(set-extent-property overlay 'start-open t)
+      (set-extent-property overlay 'start-closed t))
+    (if rear-advance
+	(set-extent-property overlay 'end-closed t)
+      (set-extent-property overlay 'end-open t))
+
+    overlay))
+
+(defun move-overlay (overlay beg end &optional buffer)
+  "Set the endpoints of OVERLAY to BEG and END in BUFFER.
+If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
+If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current
+buffer."
+  (check-argument-type 'overlayp overlay)
+  (if (null buffer)
+      (setq buffer (extent-object overlay)))
+  (if (null buffer)
+      (setq buffer (current-buffer)))
+  (check-argument-type 'bufferp buffer)
+  (and (= beg end)
+       (extent-property overlay 'evaporate)
+       (delete-overlay overlay))
+  (when (> beg end)
+    (setq beg (prog1 end (setq end beg))))
+  (set-extent-endpoints overlay beg end buffer)
+  overlay)
+
+(defun delete-overlay (overlay)
+  "Delete the overlay OVERLAY from its buffer."
+  (check-argument-type 'overlayp overlay)
+  (detach-extent overlay)
+  nil)
+
+(defun overlay-start (overlay)
+  "Return the position at which OVERLAY starts."
+  (check-argument-type 'overlayp overlay)
+  (extent-start-position overlay))
+
+(defun overlay-end (overlay)
+  "Return the position at which OVERLAY ends."
+  (check-argument-type 'overlayp overlay)
+  (extent-end-position overlay))
+
+(defun overlay-buffer (overlay)
+  "Return the buffer OVERLAY belongs to."
+  (check-argument-type 'overlayp overlay)
+  (extent-object overlay))
+
+(defun overlay-properties (overlay)
+  "Return a list of the properties on OVERLAY.
+This is a copy of OVERLAY's plist; modifying its conses has no effect on
+OVERLAY."
+  (check-argument-type 'overlayp overlay)
+  (extent-properties overlay))
+
+(defun overlays-at (pos)
+  "Return a list of the overlays that contain position POS."
+  (overlays-in pos pos))
+
+(defun overlays-in (beg end)
+  "Return a list of the overlays that overlap the region BEG ... END.
+Overlap means that at least one character is contained within the overlay
+and also contained within the specified region.
+Empty overlays are included in the result if they are located at BEG
+or between BEG and END."
+  (mapcar-extents #'identity nil nil beg end
+		  'all-extents-closed-open 'overlay))
+
+(defun next-overlay-change (pos)
+  "Return the next position after POS where an overlay starts or ends.
+If there are no more overlay boundaries after POS, return (point-max)."
+  (let ((next (point-max))
+	tmp)
+    (map-extents
+     (lambda (overlay ignore)
+	    (when (or (and (< (setq tmp (extent-start-position overlay)) next)
+			   (> tmp pos))
+		      (and (< (setq tmp (extent-end-position overlay)) next)
+			   (> tmp pos)))
+	      (setq next tmp))
+       nil)
+     nil pos nil nil 'all-extents-closed-open 'overlay)
+    next))
+
+(defun previous-overlay-change (pos)
+  "Return the previous position before POS where an overlay starts or ends.
+If there are no more overlay boundaries before POS, return (point-min)."
+  (let ((prev (point-min))
+	tmp)
+    (map-extents
+     (lambda (overlay ignore)
+       (when (or (and (> (setq tmp (extent-end-position overlay)) prev)
+		      (< tmp pos))
+		 (and (> (setq tmp (extent-start-position overlay)) prev)
+		      (< tmp pos)))
+	 (setq prev tmp))
+       nil)
+     nil nil pos nil 'all-extents-closed-open 'overlay)
+    prev))
+
+(defun overlay-lists ()
+  "Return a pair of lists giving all the overlays of the current buffer.
+The car has all the overlays before the overlay center;
+the cdr has all the overlays after the overlay center.
+Recentering overlays moves overlays between these lists.
+The lists you get are copies, so that changing them has no effect.
+However, the overlays you get are the real objects that the buffer uses."
+  (or (boundp 'xemacs-internal-overlay-center-pos)
+      (overlay-recenter (1+ (/ (- (point-max) (point-min)) 2))))
+  (let ((pos xemacs-internal-overlay-center-pos)
+	before after)
+    (map-extents (lambda (overlay ignore)
+		   (if (> pos (extent-end-position overlay))
+		       (push overlay before)
+		     (push overlay after))
+		   nil)
+		 nil nil nil nil 'all-extents-closed-open 'overlay)
+    (cons (nreverse before) (nreverse after))))
+
+(defun overlay-recenter (pos)
+  "Recenter the overlays of the current buffer around position POS."
+  (set (make-local-variable 'xemacs-internal-overlay-center-pos) pos))
+
+(defun overlay-get (overlay prop)
+  "Get the property of overlay OVERLAY with property name PROP."
+  (check-argument-type 'overlayp overlay)
+  (let ((value (extent-property overlay prop))
+	category)
+    (if (and (null value)
+	     (setq category (extent-property overlay 'category)))
+	(get category prop)
+      value)))
+
+(defun overlay-put (overlay prop value)
+  "Set one property of overlay OVERLAY: give property PROP value VALUE."
+  (check-argument-type 'overlayp overlay)
+  (cond ((eq prop 'evaporate)
+	 (set-extent-property overlay 'detachable value))
+	((eq prop 'before-string)
+	 (set-extent-property overlay 'begin-glyph
+			      (make-glyph (vector 'string :data value))))
+	((eq prop 'after-string)
+	 (set-extent-property overlay 'end-glyph
+			      (make-glyph (vector 'string :data value))))
+	((eq prop 'local-map)
+	 (set-extent-property overlay 'keymap value))
+	((memq prop '(window insert-in-front-hooks insert-behind-hooks
+			     modification-hooks))
+	 (error "cannot support overlay '%s property under XEmacs"
+		prop)))
+  (set-extent-property overlay prop value))
+
+(provide 'overlay)
+
+;;; overlay.el ends here
+(fsf-compat
+  (standards-version 1.0
+   version VERSION
+   author-version AUTHOR_VERSION
+   date DATE
+   build-date BUILD_DATE
+   maintainer MAINTAINER
+   distribution mule
+   priority high
+   category CATEGORY
+   dump nil
+   description "FSF Emacs compatibility files."
+   filename FILENAME
+   md5sum MD5SUM
+   size SIZE
+   provides (overlay thingatpt timer)
+   requires (REQUIRES)
+   type single
+))
+;;; thingatpt.el --- Get the `thing' at point
+
+;; Copyright (C) 1991,92,93,94,95,96,1997 Free Software Foundation, Inc.
+
+;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
+;; Keywords: extensions, matching, mouse
+;; Created: Thu Mar 28 13:48:23 1991
+
+;; 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
+;; its 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)
+
+;; 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 a %s" thing))))
+
+;; General routines
+
+;;;###autoload
+(defun bounds-of-thing-at-point (thing)
+  "Determine the start and end buffer locations for the THING at point.
+THING is a symbol which specifies the kind of syntactic entity you want.
+Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
+`word', `sentence', `whitespace', `line', `page' and others.
+
+See the file `thingatpt.el' for documentation on how to define
+a symbol as a valid THING.
+
+The value is a cons cell (START . END) giving the start and end positions
+of the textual entity that was found."
+  (if (get thing 'bounds-of-thing-at-point)
+      (funcall (get thing 'bounds-of-thing-at-point))
+    (let ((orig (point)))
+      (condition-case nil
+	  (save-excursion
+	    ;; Try moving forward, then back.
+	    (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 (not (and beg (> beg orig)))
+		  ;; If that brings us all the way back to ORIG,
+		  ;; it worked.  But END may not be the real end.
+		  ;; So find the real end that corresponds to BEG.
+		  (let ((real-end
+			 (progn 
+			   (funcall 
+			    (or (get thing 'end-op) 
+				(function (lambda () (forward-thing thing 1)))))
+			   (point))))
+		    (if (and beg real-end (<= beg orig) (<= orig real-end))
+			(cons beg real-end)))
+		(goto-char orig)
+		;; Try a second time, moving backward first and then forward,
+		;; so that we can find a thing that ends at ORIG.
+		(let ((beg (progn 
+			     (funcall 
+			      (or (get thing 'beginning-op) 
+				  (function (lambda () (forward-thing thing -1)))))
+			     (point)))
+		      (end (progn 
+			     (funcall 
+			      (or (get thing 'end-op) 
+				  (function (lambda () (forward-thing thing 1)))))
+			     (point)))
+		      (real-beg
+		       (progn 
+			 (funcall 
+			  (or (get thing 'beginning-op) 
+			      (function (lambda () (forward-thing thing -1)))))
+			 (point))))
+		  (if (and real-beg end (<= real-beg orig) (<= orig end))
+		      (cons real-beg end))))))
+	(error nil)))))
+
+;;;###autoload
+(defun thing-at-point (thing)
+  "Return the THING at point.
+THING is a symbol which specifies the kind of syntactic entity you want.
+Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
+`word', `sentence', `whitespace', `line', `page' and others.
+
+See the file `thingatpt.el' for documentation on how to define
+a symbol as a valid THING."
+  (if (get thing 'thing-at-point)
+      (funcall (get thing '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 
+
+;;  Lines 
+
+;; bolp will be false when you click on the last line in the buffer
+;; and it has no final newline.
+
+(put 'line 'beginning-op
+     (function (lambda () (if (bolp) (forward-line -1) (beginning-of-line)))))
+
+;;  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)
+
+(defun beginning-of-sexp ()
+  (let ((char-syntax (char-syntax (char-before (point)))))
+    (if (or (eq char-syntax ?\()
+	    (and (eq char-syntax ?\") (in-string-p)))
+	(forward-char -1)
+      (forward-sexp -1))))
+
+(put 'sexp 'beginning-op 'beginning-of-sexp)
+
+;;  Lists 
+
+(put 'list 'end-op (function (lambda () (up-list 1))))
+(put 'list 'beginning-op 'backward-sexp)
+
+;;  Filenames and URLs
+
+(defvar thing-at-point-file-name-chars "~/A-Za-z0-9---_.${}#%,:"
+  "Characters allowable in filenames.")
+
+(put 'filename 'end-op    
+     '(lambda () (skip-chars-forward thing-at-point-file-name-chars)))
+(put 'filename 'beginning-op
+     '(lambda () (skip-chars-backward thing-at-point-file-name-chars)))
+
+(defvar thing-at-point-url-path-regexp
+  "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+"
+  "A regular expression probably matching the host, path or e-mail part of a URL.")
+
+(defvar thing-at-point-short-url-regexp
+  (concat "[-A-Za-z0-9.]+" thing-at-point-url-path-regexp)
+  "A regular expression probably matching a URL without an access scheme.
+Hostname matching is stricter in this case than for
+``thing-at-point-url-regexp''.")
+
+(defvar thing-at-point-url-regexp
+  (concat
+   "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)"
+   thing-at-point-url-path-regexp)
+  "A regular expression probably matching a complete URL.")
+
+(defvar thing-at-point-markedup-url-regexp
+  "<URL:[^>]+>"
+  "A regular expression matching a URL marked up per RFC1738.
+This may contain whitespace (including newlines) .")
+
+(put 'url 'bounds-of-thing-at-point 'thing-at-point-bounds-of-url-at-point)
+(defun thing-at-point-bounds-of-url-at-point ()
+  (let ((url "") short strip)
+    (if (or (setq strip (thing-at-point-looking-at
+			 thing-at-point-markedup-url-regexp))
+	    (thing-at-point-looking-at thing-at-point-url-regexp)
+	    ;; Access scheme omitted?
+	    (setq short (thing-at-point-looking-at
+			 thing-at-point-short-url-regexp)))
+	(let ((beginning (match-beginning 0))
+	      (end (match-end 0)))
+	  (cond (strip
+		 (setq beginning (+ beginning 5))
+		 (setq end (- end 1))))
+	  (cons beginning end)))))
+
+(put 'url 'thing-at-point 'thing-at-point-url-at-point)
+(defun thing-at-point-url-at-point ()
+  "Return the URL around or before point.
+Search backwards for the start of a URL ending at or after 
+point.  If no URL found, return nil.  The access scheme, `http://'
+will be prepended if absent."
+  (let ((url "") short strip)
+    (if (or (setq strip (thing-at-point-looking-at
+			 thing-at-point-markedup-url-regexp))
+	    (thing-at-point-looking-at thing-at-point-url-regexp)
+	    ;; Access scheme omitted?
+	    (setq short (thing-at-point-looking-at
+			 thing-at-point-short-url-regexp)))
+	(progn
+	  (setq url (buffer-substring-no-properties (match-beginning 0)
+						    (match-end 0)))
+	  (and strip (setq url (substring url 5 -1))) ; Drop "<URL:" & ">"
+	  ;; strip whitespace
+	  (while (string-match "\\s +\\|\n+" url)
+	    (setq url (replace-match "" t t url)))
+	  (and short (setq url (concat (if (string-match "@" url)
+					   "mailto:" "http://") url)))
+	  (if (string-equal "" url)
+	      nil
+	    url)))))
+
+;; The normal thingatpt mechanism doesn't work for complex regexps.
+;; This should work for almost any regexp wherever we are in the
+;; match.  To do a perfect job for any arbitrary regexp would mean
+;; testing every position before point.  Regexp searches won't find
+;; matches that straddle the start position so we search forwards once
+;; and then back repeatedly and then back up a char at a time.
+
+(defun thing-at-point-looking-at (regexp)
+  "Return non-nil if point is in or just after a match for REGEXP.
+Set the match data from the earliest such match ending at or after
+point."
+  (save-excursion
+    (let ((old-point (point)) match)
+      (and (looking-at regexp)
+	   (>= (match-end 0) old-point)
+	   (setq match (point)))
+      ;; Search back repeatedly from end of next match.
+      ;; This may fail if next match ends before this match does.
+      (re-search-forward regexp nil 'limit)
+      (while (and (re-search-backward regexp nil t)
+		  (or (> (match-beginning 0) old-point)
+		      (and (looking-at regexp)	; Extend match-end past search start
+			   (>= (match-end 0) old-point)
+			   (setq match (point))))))
+      (if (not match) nil
+	(goto-char match)
+	;; Back up a char at a time in case search skipped
+	;; intermediate match straddling search start pos.
+	(while (and (not (bobp))
+		    (progn (backward-char 1) (looking-at regexp))
+		    (>= (match-end 0) old-point)
+		    (setq match (point))))
+	(goto-char match)
+	(looking-at regexp)))))
+
+(put 'url 'end-op
+     (function (lambda ()
+		 (let ((bounds (thing-at-point-bounds-of-url-at-point)))
+		   (if bounds
+		       (goto-char (cdr bounds))
+		     (error "No URL here"))))))
+(put 'url 'beginning-op
+     (function (lambda ()
+		 (let ((bounds (thing-at-point-bounds-of-url-at-point)))
+		   (if bounds
+		       (goto-char (car bounds))
+		     (error "No URL here"))))))
+
+;;  Whitespace 
+
+(defun forward-whitespace (arg)
+  (interactive "p")
+  (if (natnump arg) 
+      (re-search-forward "[ \t]+\\|\n" nil 'move arg)
+    (while (< arg 0)
+      (if (re-search-backward "[ \t]+\\|\n" nil 'move)
+	  (or (eq (char-after (match-beginning 0)) 10)
+	      (skip-chars-backward " \t")))
+      (setq arg (1+ arg)))))
+
+;;  Buffer 
+
+(put 'buffer 'end-op '(lambda () (goto-char (point-max))))
+(put 'buffer 'beginning-op '(lambda () (goto-char (point-min))))
+
+;;  Symbols 
+
+(defun forward-symbol (arg)
+  (interactive "p")
+  (if (natnump arg) 
+      (re-search-forward "\\(\\sw\\|\\s_\\)+" nil 'move arg)
+    (while (< arg 0)
+      (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil 'move)
+	  (skip-syntax-backward "w_"))
+      (setq arg (1+ arg)))))
+
+;;  Syntax blocks 
+
+(defun forward-same-syntax (&optional arg)
+  (interactive "p")
+  (while (< arg 0)
+    (skip-syntax-backward 
+     (char-to-string (char-syntax (char-after (1- (point))))))
+    (setq arg (1+ arg)))
+  (while (> arg 0)
+    (skip-syntax-forward (char-to-string (char-syntax (char-after (point)))))
+    (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.
+Signal 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.
+;;; timer.el --- run a function with args at some time in future.
+
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package gives you the capability to run Emacs Lisp commands at
+;; specified times in the future, either as one-shots or periodically.
+
+;;; Code:
+
+(require 'itimer)
+
+(fset 'timer-create 'make-itimer)
+
+(fset 'timerp 'itimerp)
+
+;(defvar timer-idle-list nil
+;  "List of active idle-time timers in order of increasing time")
+(defvaralias 'timer-idle-list 'itimer-list)
+(defvaralias 'timer-list 'itimer-list)
+
+
+(defun timer-set-time (timer time &optional delta)
+  "Set the trigger time of TIMER to TIME.
+TIME must be in the internal format returned by, e.g., `current-time'.
+If optional third argument DELTA is a non-zero integer, make the timer
+fire repeatedly that many seconds apart."
+  (set-itimer-value timer (itimer-time-difference time (current-time)))
+  (and delta (check-nonnegative-number delta))
+  (and delta (set-itimer-restart timer delta))
+  timer)
+
+(defun timer-set-idle-time (timer secs &optional repeat)
+  "Set the trigger idle time of TIMER to SECS.
+If optional third argument REPEAT is non-nil, make the timer
+fire each time Emacs is idle for that many seconds."
+  (set-itimer-is-idle timer t)
+  (set-itimer-value timer secs)
+  (when repeat
+    (set-itimer-restart timer secs))
+  timer)
+
+(defun timer-relative-time (time secs &optional usecs)
+  "Advance TIME by SECS seconds and optionally USECS microseconds.
+SECS may be a fraction."
+  (let ((high (car time))
+	(low (if (consp (cdr time)) (nth 1 time) (cdr time)))
+	(micro (if (numberp (car-safe (cdr-safe (cdr time))))
+		   (nth 2 time)
+		 0)))
+    ;; Add
+    (if usecs (setq micro (+ micro usecs)))
+    (if (floatp secs)
+	(setq micro (+ micro (floor (* 1000000 (- secs (floor secs)))))))
+    (setq low (+ low (floor secs)))
+
+    ;; Normalize
+    (setq low (+ low (/ micro 1000000)))
+    (setq micro (mod micro 1000000))
+    (setq high (+ high (/ low 65536)))
+    (setq low (logand low 65535))
+
+    (list high low (and (/= micro 0) micro))))
+
+(defun timer-inc-time (timer secs &optional usecs)
+  "Increment the time set in TIMER by SECS seconds and USECS microseconds.
+SECS may be a fraction."
+  (let ((time (itimer-value timer)))
+    (setq time (+ time secs (if (and usecs (fboundp 'lisp-float-type))
+				(/ usecs (float 1000000))
+			      0)))
+    (set-itimer-value timer time)))
+
+(defun timer-set-time-with-usecs (timer time usecs &optional delta)
+  "Set the trigger time of TIMER to TIME.
+TIME must be in the internal format returned by, e.g., `current-time'.
+If optional third argument DELTA is a non-zero integer, make the timer
+fire repeatedly that many seconds apart."
+  (let ((list (list nil nil nil)))
+    (setcar list (car time))
+    (setcar (nthcdr 1 list) (if (consp (cdr time))
+				(car (cdr time))
+			      (cdr time)))
+    (setcar (nthcdr 2 list) usecs)
+    (set-itimer-value timer (itimer-time-difference list (current-time)))
+    (set-itimer-restart timer delta)
+    timer))
+
+(defun timer-set-function (timer function &optional args)
+  "Make TIMER call FUNCTION with optional ARGS when triggering."
+  (set-itimer-function timer function)
+  (set-itimer-function-arguments timer args)
+  (set-itimer-uses-arguments timer t)
+  timer)
+
+(defun timer-activate (timer)
+  "Put TIMER on the list of active timers."
+  (activate-itimer timer))
+
+(defun timer-activate-when-idle (timer)
+  "Arrange to activate TIMER whenever Emacs is next idle."
+  (set-itimer-is-idle timer t)
+  ;(set-itimer-uses-arguments timer nil)
+  ;(unless (memq timer timer-idle-list)
+    ;(setq timer-idle-list (cons timer timer-idle-list)))
+  (activate-itimer timer))
+
+;; can't do this, different kind of timer
+;;(defalias 'disable-timeout 'cancel-timer)
+
+(defun cancel-timer (timer)
+  "Remove TIMER from the list of active timers."
+  ;(setq timer-idle-list (delq timer timer-idle-list))
+  (delete-itimer timer))
+
+(defun cancel-function-timers (function)
+  "Cancel all timers scheduled by `run-at-time' which would run FUNCTION."
+  (interactive "aCancel timers of function: ")
+  (let ((p itimer-list))
+    (while p
+      (if (eq function (itimer-function p))
+	  (progn
+	    (setq p (cdr p))
+	    (delete-itimer (car p)))
+	(setq p (cdr p))))))
+
+;;;###autoload
+(defun run-at-time (time repeat function &rest args)
+  "Perform an action after a delay of SECS seconds.
+Repeat the action every REPEAT seconds, if REPEAT is non-nil.
+TIME should be a string like \"11:23pm\", nil meaning now, a number of seconds
+from now, or a value from `encode-time'.
+REPEAT may be an integer or floating point number.
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in `cancel-timer'."
+  (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
+
+  ;; Special case: nil means "now" and is useful when repeating.
+  (if (null time)
+      (setq time (current-time)))
+
+  ;; Handle numbers as relative times in seconds.
+  (if (numberp time)
+      (setq time (timer-relative-time (current-time) time)))
+
+  ;; Handle relative times like "2 hours and 35 minutes"
+  (if (stringp time)
+      (let ((secs (timer-duration time)))
+	(if secs
+	    (setq time (timer-relative-time (current-time) secs)))))
+
+  ;; Handle "11:23pm" and the like.  Interpret it as meaning today
+  ;; which admittedly is rather stupid if we have passed that time
+  ;; already.  (Though only Emacs hackers hack Emacs at that time.)
+  (if (stringp time)
+      (progn
+	(require 'diary-lib)
+	(let ((hhmm (diary-entry-time time))
+	      (now (decode-time)))
+	  (if (>= hhmm 0)
+	      (setq time
+		    (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
+				 (nth 4 now) (nth 5 now) (nth 8 now)))))))
+
+  (or (consp time)
+      (error "Invalid time format"))
+
+  (or (null repeat)
+      (numberp repeat)
+      (error "Invalid repetition interval"))
+
+  (let ((timer (timer-create)))
+    (timer-set-time timer time repeat)
+    (timer-set-function timer function args)
+    (timer-activate timer)
+    timer))
+
+;;;###autoload
+(defun run-with-timer (secs repeat function &rest args)
+  "Perform an action after a delay of SECS seconds.
+Repeat the action every REPEAT seconds, if REPEAT is non-nil.
+SECS and REPEAT may be integers or floating point numbers.
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in `cancel-timer'."
+  (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
+  (apply 'run-at-time secs repeat function args))
+
+;;;###autoload
+(defun run-with-idle-timer (secs repeat function &rest args)
+  "Perform an action the next time Emacs is idle for SECS seconds.
+If REPEAT is non-nil, do this each time Emacs is idle for SECS seconds.
+SECS may be an integer or a floating point number.
+The action is to call FUNCTION with arguments ARGS.
+
+This function returns a timer object which you can use in `cancel-timer'."
+  (interactive
+   (list (read-from-minibuffer "Run after idle (seconds): " nil nil t)
+	 (y-or-n-p "Repeat each time Emacs is idle? ")
+	 (intern (completing-read "Function: " obarray 'fboundp t))))
+  (let ((timer (timer-create)))
+    (timer-set-function timer function args)
+    (timer-set-idle-time timer secs repeat)
+    (timer-activate-when-idle timer)
+    timer))
+
+(defun with-timeout-handler (tag)
+  (throw tag 'timeout))
+
+;;;###autoload (put 'with-timeout 'lisp-indent-function 1)
+
+;;;###autoload
+(defmacro with-timeout (list &rest body)
+  "Run BODY, but if it doesn't finish in SECONDS seconds, give up.
+If we give up, we run the TIMEOUT-FORMS and return the value of the last one.
+The call should look like:
+ (with-timeout (SECONDS TIMEOUT-FORMS...) BODY...)
+The timeout is checked whenever Emacs waits for some kind of external
+event \(such as keyboard input, input from subprocesses, or a certain time);
+if the program loops without waiting in any way, the timeout will not
+be detected."
+  (let ((seconds (car list))
+	(timeout-forms (cdr list)))
+    `(let ((with-timeout-tag (cons nil nil))
+	   with-timeout-value with-timeout-timer)
+       (if (catch with-timeout-tag
+	     (progn
+	       (setq with-timeout-timer
+		     (run-with-timer ,seconds nil
+				      'with-timeout-handler
+				      with-timeout-tag))
+	       (setq with-timeout-value (progn . ,body))
+	       nil))
+	   (progn . ,timeout-forms)
+	 (cancel-timer with-timeout-timer)
+	 with-timeout-value))))
+
+(defun y-or-n-p-with-timeout (prompt seconds default-value)
+  "Like (y-or-n-p PROMPT), with a timeout.
+If the user does not answer after SECONDS seconds, return DEFAULT-VALUE."
+  (with-timeout (seconds default-value)
+    (y-or-n-p prompt)))
+
+(defvar timer-duration-words
+  (list (cons "microsec" 0.000001)
+	(cons "microsecond" 0.000001)
+        (cons "millisec" 0.001)
+	(cons "millisecond" 0.001)
+        (cons "sec" 1)
+	(cons "second" 1)
+	(cons "min" 60)
+	(cons "minute" 60)
+	(cons "hour" (* 60 60))
+	(cons "day" (* 24 60 60))
+	(cons "week" (* 7 24 60 60))
+	(cons "fortnight" (* 14 24 60 60))
+	(cons "month" (* 30 24 60 60))	  ; Approximation
+	(cons "year" (* 365.25 24 60 60)) ; Approximation
+	)
+  "Alist mapping temporal words to durations in seconds")
+
+(defun timer-duration (string)
+  "Return number of seconds specified by STRING, or nil if parsing fails."
+  (let ((secs 0)
+	(start 0)
+	(case-fold-search t))
+    (while (string-match
+	    "[ \t]*\\([0-9.]+\\)?[ \t]*\\([a-z]+[a-rt-z]\\)s?[ \t]*"
+	    string start)
+      (let ((count (if (match-beginning 1)
+		       (string-to-number (match-string 1 string))
+		     1))
+	    (itemsize (cdr (assoc (match-string 2 string)
+				  timer-duration-words))))
+	(if itemsize
+	    (setq start (match-end 0)
+		  secs (+ secs (* count itemsize)))
+	  (setq secs nil
+		start (length string)))))
+    (if (= start (length string))
+	secs
+      (if (string-match "\\`[0-9.]+\\'" string)
+	  (string-to-number string)))))
+
+(provide 'timer)
+
+;;; timer.el ends here