home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / x-sb-mouse / thing.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  4.3 KB  |  146 lines
  1. ;; Thing.el
  2. ;; adapted from sun-fns.el by Joshua Guttman, MITRE.  
  3. ;; Comments appreciated: guttman@mitre.org
  4.  
  5.  
  6. (provide 'thing)
  7.  
  8. (defun thing-boundaries (here)
  9.   "Return start and end of text object at HERE using syntax table and thing-boundary-alist.  
  10. Thing-boundary-alist is a list of pairs of the form (SYNTAX-CHAR FUNCTION)
  11. where FUNCTION takes a single position argument and returns a cons of places
  12.  (start end) representing boundaries of the thing at that position.  
  13. Typically:
  14.  Left or right Paren syntax indicates an s-expression.    
  15.  The end of a line marks the line including a trailing newline. 
  16.  Word syntax indicates current word. 
  17.  Symbol syntax indicates symbol.
  18.  If it doesn't recognize one of these it selects just the character HERE."
  19.   (interactive "d")
  20.   (if (save-excursion
  21.     (goto-char here)
  22.     (eolp))
  23.       (thing-get-line here)
  24.     (let* ((syntax
  25.         (char-syntax (char-after here)))
  26.        (pair
  27.         (assq syntax thing-boundary-alist)))
  28.     
  29.       (if pair
  30.       (funcall (car (cdr pair)) here)
  31.     (cons here (1+ here))))))  
  32.  
  33.  
  34. (defvar thing-boundary-alist
  35.   '((?w thing-word)
  36.     (?_ thing-symbol)
  37.     (?\( thing-sexp-start)
  38.     (?\$ thing-sexp-start)
  39.     (?' thing-sexp-start)
  40.     (?\" thing-sexp-start)
  41.     (?\) thing-sexp-end)
  42.     (?  thing-whitespace))
  43.   "*List of pairs of the form (SYNTAX-CHAR FUNCTION) used by THING-BOUNDARIES.")
  44.   
  45. (defun thing-get-line (here)
  46.   "Return whole of line HERE is in, with newline unless at eob."
  47.   (save-excursion
  48.     (goto-char here)
  49.     (let* ((start (progn (beginning-of-line 1)
  50.              (point)))
  51.        (end (progn (forward-line 1)
  52.                (point))))
  53.       (cons start end))))
  54.  
  55. (defun thing-word (here)
  56.   "Return start and end of word at HERE."
  57.   (save-excursion
  58.     (goto-char here)
  59.     (forward-word 1)
  60.     (let ((end (point)))
  61.       (forward-word -1)
  62.       (cons (point) end))))
  63.  
  64. (defun thing-symbol (here)
  65.   "Return start and end of symbol at HERE."
  66.   (let ((end (scan-sexps here 1)))
  67.     (cons (min here (scan-sexps end -1))
  68.       end)))
  69.  
  70. (defun thing-sexp-start (here)
  71.   "Return start and end of sexp starting HERE."
  72.   (cons here (scan-sexps here 1)))
  73.  
  74. (defun thing-sexp-end (here)
  75.   "Return start and end of sexp ending HERE."
  76.   (cons (scan-sexps (1+ here) -1)
  77.     (1+ here)))
  78.  
  79. (defun thing-whitespace (here)
  80.   "Return start to end of all but one char of whitespace HERE, unless 
  81. there's only one char of whitespace.  Then return start to end of it."
  82.   (save-excursion
  83.     (let ((start (progn
  84.            (skip-chars-backward " \t") (1+ (point))))
  85.       (end (progn 
  86.          (skip-chars-forward " \t") (point))))
  87.       (if (= start end)
  88.       (cons (1- start) end)
  89.     (cons start end)))))
  90.  
  91.  
  92.  
  93.  
  94.  
  95. (defun mark-thing-at-point (here)
  96.   "Set point at beginning and mark at end of text object using syntax table.
  97. See thing-boundaries for definition of text objects"
  98.   (interactive "d")
  99.   (let ((bounds (thing-boundaries here)))
  100.     (goto-char (cdr bounds))
  101.     (set-mark-command nil)
  102.     (goto-char (car bounds))))
  103.  
  104. (defun kill-thing-at-point (here)
  105.   "Kill text object using syntax table.
  106. See thing-boundaries for definition of text objects"
  107.   (interactive "d")
  108.   (let ((bounds (thing-boundaries here)))
  109.     (kill-region (car bounds) (cdr bounds))))
  110.  
  111.  
  112. (defun copy-thing-at-point (here)
  113.   "Copy text object using syntax table.
  114. See thing-boundaries for definition of text objects"
  115.   (interactive "d")
  116.   (let ((bounds (thing-boundaries here)))
  117.     (copy-region-as-kill (car bounds) (cdr bounds))))
  118.  
  119. ;;; Two X-related fns.      
  120. ;;;        
  121. ;;;(defun x-mouse-kill-thing (arg)
  122. ;;;  "Kill text object at point or mouse position and insert into window system cut buffer.
  123. ;;;Save in Emacs kill ring also."
  124. ;;;  (interactive "d")
  125. ;;;  (setq last-command nil)
  126. ;;;  (x-mouse-set-point arg)
  127. ;;;  (let* ((bounds (thing-boundaries (point)))
  128. ;;;     (start (car bounds))
  129. ;;;     (end (cdr bounds)))
  130. ;;;    (x-store-cut-buffer (buffer-substring start end))
  131. ;;;    (kill-region start end)))
  132. ;;;
  133. ;;;(defun x-mouse-copy-thing (arg)
  134. ;;;  "Copy text object at point or mouse position into window system cut buffer.
  135. ;;;Save in Emacs kill ring also."
  136. ;;;  (save-excursion
  137. ;;;    (save-window-excursion
  138. ;;;      (setq last-command nil)
  139. ;;;      (x-mouse-set-point arg)
  140. ;;;      (let* ((bounds (thing-boundaries (point)))
  141. ;;;         (start (car bounds))
  142. ;;;         (end (cdr bounds)))
  143. ;;;    (x-store-cut-buffer (buffer-substring start end))
  144. ;;;    (copy-region-as-kill start end)))))
  145.  
  146.