home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / location.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  12.5 KB  |  329 lines
  1. ;From ark1!uakari.primate.wisc.edu!samsung!cs.utexas.edu!tut.cis.ohio-state.edu!indetech.com!lrs Tue May  8 15:00:41 1990
  2. ;Article 993 of gnu.emacs.bug:
  3. ;Path: ark1!uakari.primate.wisc.edu!samsung!cs.utexas.edu!tut.cis.ohio-state.edu!indetech.com!lrs
  4. ;>From lrs@indetech.com (Lynn Slater)
  5. ;Newsgroups: gnu.emacs.bug
  6. ;Subject: Pop mark across buffers
  7. ;Message-ID: <m0hPirJ-0000FBC@fire.indetech.com>
  8. ;Date: 30 Apr 90 22:04:00 GMT
  9. ;Sender: daemon@tut.cis.ohio-state.edu
  10. ;Distribution: gnu
  11. ;Organization: GNUs Not Usenet
  12. ;Lines: 313
  13. ;
  14. ;
  15. ;> When working in multiple-file programs, and using find-tag a lot, it
  16. ;> would be nice if there were an analogue to pop-mark within a buffer so
  17. ;> that you could pop back to where you were looking (like Info-last).
  18. ;
  19. ;Here is a rather old but still good change that allow this. I can browse
  20. ;functions following an execution thread and then "pop" the stack back to
  21. ;any previous node -- a great timesaver!
  22.  
  23. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24. ;; location.el --- enhancements to find-tag that allow backtracking path.
  25. ;; Author          : Lynn Slater
  26. ;; Created On      : Wed Dec  2 14:19:18 1987
  27. ;; Last Modified By: Lynn Slater
  28. ;; Last Modified On: Fri Oct 28 14:41:00 1988
  29. ;; Update Count    : 8
  30. ;; Status          : Not cleaned up, but reliable
  31. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. ;; Copyright (C) 1988 Lynn Randolph Slater, Jr.
  33. ;; This file might become part of GNU Emacs.
  34. ;;
  35. ;; This file is distributed in the hope that it will be useful,
  36. ;; but without any warranty.  No author or distributor
  37. ;; accepts responsibility to anyone for the consequences of using it
  38. ;; or for whether it serves any particular purpose or works at all,
  39. ;; unless he says so in writing.
  40. ;;
  41. ;; Everyone is granted permission to copy, modify and redistribute
  42. ;; this file, but only under the conditions described in the
  43. ;; document "GNU Emacs copying permission notice".   An exact copy
  44. ;; of the document is supposed to have been given to you along with
  45. ;; this file so that you can know how you may redistribute it all.
  46. ;; It should be in a file named COPYING.  Among other things, the
  47. ;; copyright notice and this notice must be preserved on all copies.
  48.  
  49. ;; Make this file location.el, byte-compile it in your path
  50.  
  51. (provide 'location)
  52.  
  53. (defvar user-location-list nil
  54.   "Stores list of where the user was.
  55.    Each entry is of the form (buffer-name . point)
  56.    Entries may be added by the fcn record-user-location.
  57.    Entries may be altered by the fcn rerecord-user-location.
  58.    Entries may be revisited with revisit-last-user-location.
  59.    Entries may be forgotten with forget-last-user-location.
  60.    Entries may be undone by backtrack-to-last-user-location.
  61.  
  62.    This is intended to form a set of general utilities usefull for any
  63.    modes or command sets that visit lots of buffer or files.  See the
  64.    extended tags browsing system for examples.")
  65.  
  66. (defun reset-user-location-list ()
  67.   "See the documentation on the variable user-location-list"
  68.   (interactive)
  69.   (setq user-location-list nil))
  70.  
  71. (defun record-user-location (&optional buffer-name point)
  72.   "Stores the  buffer and point. Uses current buffer and point by default.
  73.    The old location is pushed down on the stack. See
  74.    user-location-list variable"
  75.   (interactive)
  76.   (setq user-location-list (cons (cons (or buffer-name (buffer-name))
  77.                        (or point (point)))
  78.                  user-location-list)))
  79.  
  80. (defun mark-and-record ()
  81.   "Sets the mark but also records the current location so that you may
  82.    return to this particular place through the
  83.    backtrack-to-last-user-location command (bound to \\[backtrack-to-last-user-location])."
  84.   (interactive)
  85.   (record-user-location)
  86.   (set-mark-command nil))
  87.  
  88. (defun mark-and-record ()
  89.   "Sets the mark but also records the current location so that you may
  90.    return to this particular place through the
  91.    backtrack-to-last-user-location command (bound to \\[backtrack-to-last-user-location])."
  92.   (interactive)
  93.   (record-user-location)
  94.   (set-mark-command nil))
  95.  
  96. (defun rerecord-user-location (&optional buffer-name point)
  97.   "Stores the  buffer and point. Uses current buffer and point by default."
  98.   (forget-last-user-location)
  99.   (record-user-location))
  100.  
  101. (defun revisit-last-user-location ()
  102.   "Switches buffer and point to the last values"
  103.   (interactive)
  104.   (switch-to-buffer (car (car user-location-list)))
  105.   (goto-char (or (cdr (car user-location-list)) (point))))      
  106.  
  107. (defun forget-last-user-location ()
  108.   "Forgets last stored buffer and point. See last-user-location-list variable"
  109.   (setq user-location-list (cdr user-location-list)))
  110.  
  111. (defun backtrack-to-last-user-location (&optional junk1 junk2 junk3 junk4)
  112.   "Goes to last stored buffer and point. See last-user-location-list variable
  113.    Also pops the location off of the stack
  114.    Acts as (switch-to-buffer nil) if there is no stored last location."
  115.   (interactive)
  116.   (revisit-last-user-location)
  117.   (forget-last-user-location))
  118.  
  119. ;; user-location-list
  120. ;; (revisit-last-user-location)
  121. ;; (backtrack-to-last-user-location)
  122. ;; reset-user-location-list
  123.  
  124. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  125. ;; To enhance tags, uncomment the following in this file or replace
  126. ;; find-tag in tags.el
  127. ;;    (Release 18.51)
  128. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  129.  
  130. ;;-ok->(load "tags")
  131.  
  132. ;;-ok->(defun find-tag (tagname &optional next other-window)
  133. ;;-ok->  "Find tag (in current tag table) whose name contains TAGNAME.
  134. ;;-ok-> Selects the buffer that the tag is contained in
  135. ;;-ok->and puts point at its definition.
  136. ;;-ok-> If TAGNAME is a null string, the expression in the buffer
  137. ;;-ok->around or before point is used as the tag name.
  138. ;;-ok-> If second arg NEXT is non-nil (interactively, with prefix arg),
  139. ;;-ok->searches for the next tag in the tag table
  140. ;;-ok->that matches the tagname used in the previous find-tag.
  141. ;;-ok->
  142. ;;-ok->See documentation of variable tags-file-name."
  143. ;;-ok->  (interactive (if current-prefix-arg
  144. ;;-ok->           '(nil t)
  145. ;;-ok->         (find-tag-tag "Find tag: ")))
  146. ;;-ok->  (let (buffer file linebeg startpos)
  147. ;;-ok->    (save-excursion
  148. ;;-ok->     (visit-tags-table-buffer)
  149. ;;-ok->     (if (not next)
  150. ;;-ok->     (goto-char (point-min))
  151. ;;-ok->       (setq tagname last-tag))
  152. ;;-ok->     (setq last-tag tagname)
  153. ;;-ok->     (while (progn
  154. ;;-ok->          (if (not (search-forward tagname nil t))
  155. ;;-ok->          (error "No %sentries containing %s"
  156. ;;-ok->             (if next "more " "") tagname))
  157. ;;-ok->          (not (looking-at "[^\n\177]*\177"))))
  158. ;;-ok->     (search-forward "\177")
  159. ;;-ok->     (setq file (expand-file-name (file-of-tag)
  160. ;;-ok->                  (file-name-directory tags-file-name)))
  161. ;;-ok->     (setq linebeg
  162. ;;-ok->       (buffer-substring (1- (point))
  163. ;;-ok->                 (save-excursion (beginning-of-line) (point))))
  164. ;;-ok->     (search-forward ",")
  165. ;;-ok->     (setq startpos (read (current-buffer))))
  166. ;;-ok->    (if (not next) (record-user-location)) ;; lrs
  167. ;;-ok->    (if other-window
  168. ;;-ok->    (find-file-other-window file)
  169. ;;-ok->      (find-file file))
  170. ;;-ok->    (widen)
  171. ;;-ok->    (push-mark)
  172. ;;-ok->    (let ((offset 1000)
  173. ;;-ok->      found
  174. ;;-ok->      (pat (concat "^" (regexp-quote linebeg))))
  175. ;;-ok->      (or startpos (setq startpos (point-min)))
  176. ;;-ok->      (while (and (not found)
  177. ;;-ok->          (progn
  178. ;;-ok->           (goto-char (- startpos offset))
  179. ;;-ok->           (not (bobp))))
  180. ;;-ok->    (setq found
  181. ;;-ok->          (re-search-forward pat (+ startpos offset) t))
  182. ;;-ok->    (setq offset (* 3 offset)))
  183. ;;-ok->      (or found
  184. ;;-ok->      (re-search-forward pat nil t)
  185. ;;-ok->      (error "%s not found in %s" pat file)))
  186. ;;-ok->    (beginning-of-line))
  187. ;;-ok->  (setq tags-loop-form '(find-tag nil t))
  188. ;;-ok->  ;; Return t in case used as the tags-loop-form.
  189. ;;-ok->  t)
  190.  
  191. (global-set-key  "\e\C-l" 'backtrack-to-last-user-location)
  192.  
  193. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  194. ;; Define xwindow support for ez code browsing
  195. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  196. ;;->(defun find-tag-at-point ()
  197. ;;->  "finds the tag at the point without user interaction.
  198. ;;->   If the tag is the same as the last tag, the next occurance of the
  199. ;;->   tag is found instead."
  200. ;;->  (let ((this-tag  (save-excursion
  201. ;;->             (buffer-substring
  202. ;;->              (progn (backward-sexp 1) (point))
  203. ;;->              (progn (forward-sexp 1) (point))))))
  204. ;;->    (if (equal this-tag last-tag) ;; use string-matfch instead?
  205. ;;->    (find-tag last-tag t)
  206. ;;->      (find-tag this-tag))
  207. ;;->    ))
  208. ;;->
  209. ;;->(defun x-mouse-set-point-or-hunt (arg)
  210. ;;->  "Select Emacs window mouse is on, and move point to mouse position."
  211. ;;->  (let* ((relative-coordinate (x-mouse-select arg))
  212. ;;->     (rel-x (car relative-coordinate))
  213. ;;->     (rel-y (car (cdr relative-coordinate)))
  214. ;;->     (old-p (point)))
  215. ;;->    (if relative-coordinate
  216. ;;->    (progn
  217. ;;->      (move-to-window-line rel-y)
  218. ;;->      (move-to-column (+ rel-x (current-column)))
  219. ;;->      (if (eq (point) old-p);; click twice to find tag
  220. ;;->          (find-tag-at-point)))
  221. ;;->      (progn
  222. ;;->    ;;(x-scroll-window arg)
  223. ;;->    )
  224. ;;->      )))
  225. ;;->
  226. ;;->(defun x-scroll-window (arg)
  227. ;;->  (if (< (car arg) (/ (window-width) 2))
  228. ;;->      (scroll-down (/ (window-height) 2))
  229. ;;->    (scroll-up (/ (window-height) 2))))
  230. ;;->
  231. ;;->(defun x-mouse-select (arg)
  232. ;;->  "Select Emacs window the mouse is on."
  233. ;;->  (let ((start-w (selected-window))
  234. ;;->    (done nil)
  235. ;;->    (w (selected-window))
  236. ;;->    (rel-coordinate nil)
  237. ;;->    (arg2 (list (car arg) (- (car (cdr arg)) 1)))
  238. ;;->    )
  239. ;;->    ;;(message "looking for select %s" arg) (sit-for 1)
  240. ;;->    (while (and (not done)
  241. ;;->        (null (setq rel-coordinate
  242. ;;->                (coordinates-in-window-p arg w))))
  243. ;;->      (setq w (next-window w))
  244. ;;->      (if (eq w start-w)
  245. ;;->      (setq done t)))
  246. ;;->    (if rel-coordinate
  247. ;;->    (select-window w)
  248. ;;->      (progn;; scroll instead
  249. ;;->    ;;(message "looking for scroll %s" arg2) (sit-for 1)
  250. ;;->    (setq w (selected-window))
  251. ;;->    (setq done ())
  252. ;;->    (while (and (not done)
  253. ;;->            (null (setq rel-coordinate
  254. ;;->                (coordinates-in-window-p arg2 w))))
  255. ;;->      (setq w (next-window w))
  256. ;;->      (if (eq w start-w)
  257. ;;->          (setq done t)))
  258. ;;->    ;;(message "found rel %s" rel-coordinate) (sit-for 2)
  259. ;;->    (if rel-coordinate
  260. ;;->        (progn
  261. ;;->          (select-window w)
  262. ;;->          (if (< (car rel-coordinate) (/ (window-width) 2))
  263. ;;->          (scroll-down (/ (window-height) 2))
  264. ;;->        (scroll-up (/ (window-height) 2)))))
  265. ;;->    (setq rel-coordinate ())
  266. ;;->    ))
  267. ;;->    rel-coordinate))
  268. ;;->
  269. ;;->(defun x-mouse-find-more (arg)
  270. ;;->  ""
  271. ;;->  (find-tag last-tag t))
  272. ;;->
  273. ;;->(defun mouse-find-more (window x y)
  274. ;;->  ""
  275. ;;->  (find-tag last-tag t))
  276. ;;->
  277. ;;->(defun mouse-drag-move-point-or-find (window x y)
  278. ;;->  (let ((pt (point))
  279. ;;->    (w (selected-window)))
  280. ;;->    (mouse-drag-move-point window x y)
  281. ;;->    (if (and (eq w (selected-window))
  282. ;;->         (eq pt (point)))
  283. ;;->    (find-tag-at-point))))
  284. ;;->    
  285. ;;->(defun quick-browse ()
  286. ;;->  "Activates the quick browse key mappings:
  287. ;;->   Left= find-tag. Be sure to hold down the key to see the messages
  288. ;;->   Middle = tags-loop-continue
  289. ;;->   Right = backtrack-to-last-user-location"
  290. ;;->  (interactive)
  291. ;;->  (cond ((eq window-system 'x)
  292. ;;->     ;; (substitute-key-definition 'x-mouse-select
  293. ;;->     ;;                'x-mouse-set-point-or-hunt
  294. ;;->     ;;                mouse-map)
  295. ;;->     ;; (substitute-key-definition 'x-mouse-set-mark
  296. ;;->     ;;                'x-mouse-find-more
  297. ;;->     ;;                mouse-map)
  298. ;;->     ;; (substitute-key-definition 'x-mouse-set-point
  299. ;;->     ;;                'backtrack-to-last-user-location
  300. ;;->     ;;                mouse-map)
  301. ;;->     (define-key mouse-map x-button-left 'x-mouse-set-point-or-hunt)
  302. ;;->     (define-key mouse-map x-button-middle 'x-mouse-find-more)
  303. ;;->     (define-key mouse-map x-button-right 'backtrack-to-last-user-location)
  304. ;;->     )
  305. ;;->    ((null window-system)
  306. ;;->     (global-set-mouse '(text left)      'mouse-drag-move-point-or-find)
  307. ;;->     (global-set-mouse '(text middle) 'mouse-find-more)
  308. ;;->     (global-set-mouse '(text right)  'backtrack-to-last-user-location))
  309. ;;->    (t (error "Unrecognized window system for quick browsal"))))
  310. ;;->
  311. ;;->(defun end-quick-browse ()
  312. ;;->  "De-Activates the quick browse key mappings."
  313. ;;->  (interactive)
  314. ;;->  (cond ((eq window-system 'x)
  315. ;;->     (define-key mouse-map x-button-right 'x-mouse-select)
  316. ;;->     (define-key mouse-map x-button-left 'x-mouse-set-mark)
  317. ;;->     (define-key mouse-map x-button-middle 'x-mouse-set-point)
  318. ;;->     )
  319. ;;->    ((null window-system)
  320. ;;->     (global-set-mouse '(text        left)    'mouse-drag-move-point)
  321. ;;->     (global-set-mouse '(text    middle)    'mouse-set-mark-and-stuff)
  322. ;;->     (global-set-mouse '(text    right)    'emacs-menu-eval)
  323. ;;->     )
  324. ;;->    (t (error "Unrecognized window system for quick browsal"))))
  325. ;;->
  326. ;;->;; (load "location")
  327.  
  328.  
  329.