|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: T l
Length: 11207 (0x2bc7) Types: TextFile Names: »location.el«
└─⟦a05ed705a⟧ Bits:30007078 DKUUG GNU 2/12/89 └─⟦dbcd4071d⟧ »./gnu-ada-1.05.tar.Z« └─⟦999713de5⟧ └─⟦this⟧ »location.el«
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; location.el --- enhancements to find-tag that allow backtracking path. ;; Author : Lynn Slater ;; Created On : Wed Dec 2 14:19:18 1987 ;; Last Modified By: Lynn Slater ;; Last Modified On: Tue Sep 6 07:54:54 1988 ;; Update Count : 7 ;; Status : Not cleaned up, but reliable ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Copyright (C) 1988 Lynn Randolph Slater, Jr. ;; This file might become part of GNU Emacs. ;; ;; This file is distributed in the hope that it will be useful, ;; but without any warranty. No author or distributor ;; accepts responsibility to anyone for the consequences of using it ;; or for whether it serves any particular purpose or works at all, ;; unless he says so in writing. ;; ;; Everyone is granted permission to copy, modify and redistribute ;; this file, but only under the conditions described in the ;; document "GNU Emacs copying permission notice". An exact copy ;; of the document is supposed to have been given to you along with ;; this file so that you can know how you may redistribute it all. ;; It should be in a file named COPYING. Among other things, the ;; copyright notice and this notice must be preserved on all copies. ;; Make this file location.el, byte-compile it in your path (provide 'location) (defvar user-location-list nil "Stores list of where the user was. Each entry is of the form (buffer-name . point) Entries may be added by the fcn record-user-location. Entries may be altered by the fcn rerecord-user-location. Entries may be revisited with revisit-last-user-location. Entries may be forgotten with forget-last-user-location. Entries may be undone by backtrack-to-last-user-location. This is intended to form a set of general utilities usefull for any modes or command sets that visit lots of buffer or files. See the extended tags browsing system for examples.") (defun reset-user-location-list () "See the documentation on the variable user-location-list" (interactive) (setq user-location-list nil)) (defun record-user-location (&optional buffer-name point) "Stores the buffer and point. Uses current buffer and point by default. The old location is pushed down on the stack. See user-location-list variable" (interactive) (setq user-location-list (cons (cons (or buffer-name (buffer-name)) (or point (point))) user-location-list))) (defun mark-and-record () "Sets the mark but also records the current location so that you may return to this particular place through the backtrack-to-last-user-location command (bound to \\[backtrack-to-last-user-location])." (interactive) (record-user-location) (set-mark-command nil)) (defun mark-and-record () "Sets the mark but also records the current location so that you may return to this particular place through the backtrack-to-last-user-location command (bound to \\[backtrack-to-last-user-location])." (interactive) (record-user-location) (set-mark-command nil)) (defun rerecord-user-location (&optional buffer-name point) "Stores the buffer and point. Uses current buffer and point by default." (forget-last-user-location) (record-user-location)) (defun revisit-last-user-location () "Switches buffer and point to the last values" (interactive) (switch-to-buffer (car (car user-location-list))) (goto-char (or (cdr (car user-location-list)) (point)))) (defun forget-last-user-location () "Forgets last stored buffer and point. See last-user-location-list variable" (setq user-location-list (cdr user-location-list))) (defun backtrack-to-last-user-location (&optional junk1 junk2 junk3 junk4) "Goes to last stored buffer and point. See last-user-location-list variable Also pops the location off of the stack Acts as (switch-to-buffer nil) if there is no stored last location." (interactive) (revisit-last-user-location) (forget-last-user-location)) ;; user-location-list ;; (revisit-last-user-location) ;; (backtrack-to-last-user-location) ;; reset-user-location-list ;; enhanced tags subsystem ;;(load "tags") ;;-> (defun find-tag (tagname &optional next other-window) ;;-> "Find tag (in current tag table) whose name contains TAGNAME. ;;-> Selects the buffer that the tag is contained in ;;-> and puts point at its definition. ;;-> If TAGNAME is a null string, the expression in the buffer ;;-> around or before point is used as the tag name. ;;-> If second arg NEXT is non-nil (interactively, with prefix arg), ;;-> searches for the next tag in the tag table ;;-> that matches the tagname used in the previous find-tag. ;;-> ;;-> See documentation of variable tags-file-name." ;;-> (interactive (if current-prefix-arg ;;-> '(nil t) ;;-> (find-tag-tag nil "Find tag: "))) ;;-> (setq tagname (find-tag-tag tagname)) ;;-> (let (buffer file linebeg startpos) ;;-> (save-excursion ;;-> (visit-tags-table-buffer) ;;-> (if (not next) ;;-> (goto-char (point-min)) ;;-> (setq tagname last-tag)) ;;-> (setq last-tag tagname) ;;-> (while (progn ;;-> (search-forward tagname) ;;-> (not (looking-at "[^\n\177]*\177")))) ;;-> (search-forward "\177") ;;-> (setq file (expand-file-name (file-of-tag) ;;-> (file-name-directory tags-file-name))) ;;-> (setq linebeg ;;-> (buffer-substring (1- (point)) ;;-> (save-excursion (beginning-of-line) (point)))) ;;-> (search-forward ",") ;;-> (setq startpos (read (current-buffer)))) ;;-> (if (not next) (record-user-location)) ;; lrs ;;-> (if other-window ;;-> (find-file-other-window file) ;;-> (find-file file)) ;;-> (widen) ;;-> (push-mark) ;;-> (let ((offset 1000) ;;-> found ;;-> (pat (concat "^" (regexp-quote linebeg)))) ;;-> (or startpos (setq startpos (point-min))) ;;-> (while (and (not found) ;;-> (progn ;;-> (goto-char (- startpos offset)) ;;-> (not (bobp)))) ;;-> (setq found ;;-> (re-search-forward pat (+ startpos offset) t)) ;;-> (setq offset (* 3 offset))) ;;-> (or found ;;-> (re-search-forward pat))) ;;-> (beginning-of-line)) ;;-> (setq tags-loop-form '(find-tag nil t)) ;;-> ;; Return t in case used as the tags-loop-form. ;;-> t) (global-set-key "\e\C-l" 'backtrack-to-last-user-location) ;; now, comes xwindow support for ez code browsing ;;->(defun find-tag-at-point () ;;-> "finds the tag at the point without user interaction. ;;-> If the tag is the same as the last tag, the next occurance of the ;;-> tag is found instead." ;;-> (let ((this-tag (save-excursion ;;-> (buffer-substring ;;-> (progn (backward-sexp 1) (point)) ;;-> (progn (forward-sexp 1) (point)))))) ;;-> (if (equal this-tag last-tag) ;; use string-matfch instead? ;;-> (find-tag last-tag t) ;;-> (find-tag this-tag)) ;;-> )) ;;-> ;;->(defun x-mouse-set-point-or-hunt (arg) ;;-> "Select Emacs window mouse is on, and move point to mouse position." ;;-> (let* ((relative-coordinate (x-mouse-select arg)) ;;-> (rel-x (car relative-coordinate)) ;;-> (rel-y (car (cdr relative-coordinate))) ;;-> (old-p (point))) ;;-> (if relative-coordinate ;;-> (progn ;;-> (move-to-window-line rel-y) ;;-> (move-to-column (+ rel-x (current-column))) ;;-> (if (eq (point) old-p);; click twice to find tag ;;-> (find-tag-at-point))) ;;-> (progn ;;-> ;;(x-scroll-window arg) ;;-> ) ;;-> ))) ;;-> ;;->(defun x-scroll-window (arg) ;;-> (if (< (car arg) (/ (window-width) 2)) ;;-> (scroll-down (/ (window-height) 2)) ;;-> (scroll-up (/ (window-height) 2)))) ;;-> ;;->(defun x-mouse-select (arg) ;;-> "Select Emacs window the mouse is on." ;;-> (let ((start-w (selected-window)) ;;-> (done nil) ;;-> (w (selected-window)) ;;-> (rel-coordinate nil) ;;-> (arg2 (list (car arg) (- (car (cdr arg)) 1))) ;;-> ) ;;-> ;;(message "looking for select %s" arg) (sit-for 1) ;;-> (while (and (not done) ;;-> (null (setq rel-coordinate ;;-> (coordinates-in-window-p arg w)))) ;;-> (setq w (next-window w)) ;;-> (if (eq w start-w) ;;-> (setq done t))) ;;-> (if rel-coordinate ;;-> (select-window w) ;;-> (progn;; scroll instead ;;-> ;;(message "looking for scroll %s" arg2) (sit-for 1) ;;-> (setq w (selected-window)) ;;-> (setq done ()) ;;-> (while (and (not done) ;;-> (null (setq rel-coordinate ;;-> (coordinates-in-window-p arg2 w)))) ;;-> (setq w (next-window w)) ;;-> (if (eq w start-w) ;;-> (setq done t))) ;;-> ;;(message "found rel %s" rel-coordinate) (sit-for 2) ;;-> (if rel-coordinate ;;-> (progn ;;-> (select-window w) ;;-> (if (< (car rel-coordinate) (/ (window-width) 2)) ;;-> (scroll-down (/ (window-height) 2)) ;;-> (scroll-up (/ (window-height) 2))))) ;;-> (setq rel-coordinate ()) ;;-> )) ;;-> rel-coordinate)) ;;-> ;;->(defun x-mouse-find-more (arg) ;;-> "" ;;-> (find-tag last-tag t)) ;;-> ;;->(defun mouse-find-more (window x y) ;;-> "" ;;-> (find-tag last-tag t)) ;;-> ;;->(defun mouse-drag-move-point-or-find (window x y) ;;-> (let ((pt (point)) ;;-> (w (selected-window))) ;;-> (mouse-drag-move-point window x y) ;;-> (if (and (eq w (selected-window)) ;;-> (eq pt (point))) ;;-> (find-tag-at-point)))) ;;-> ;;->(defun quick-browse () ;;-> "Activates the quick browse key mappings: ;;-> Left= find-tag. Be sure to hold down the key to see the messages ;;-> Middle = tags-loop-continue ;;-> Right = backtrack-to-last-user-location" ;;-> (interactive) ;;-> (cond ((eq window-system 'x) ;;-> ;; (substitute-key-definition 'x-mouse-select ;;-> ;; 'x-mouse-set-point-or-hunt ;;-> ;; mouse-map) ;;-> ;; (substitute-key-definition 'x-mouse-set-mark ;;-> ;; 'x-mouse-find-more ;;-> ;; mouse-map) ;;-> ;; (substitute-key-definition 'x-mouse-set-point ;;-> ;; 'backtrack-to-last-user-location ;;-> ;; mouse-map) ;;-> (define-key mouse-map x-button-left 'x-mouse-set-point-or-hunt) ;;-> (define-key mouse-map x-button-middle 'x-mouse-find-more) ;;-> (define-key mouse-map x-button-right 'backtrack-to-last-user-location) ;;-> ) ;;-> ((null window-system) ;;-> (global-set-mouse '(text left) 'mouse-drag-move-point-or-find) ;;-> (global-set-mouse '(text middle) 'mouse-find-more) ;;-> (global-set-mouse '(text right) 'backtrack-to-last-user-location)) ;;-> (t (error "Unrecognized window system for quick browsal")))) ;;-> ;;->(defun end-quick-browse () ;;-> "De-Activates the quick browse key mappings." ;;-> (interactive) ;;-> (cond ((eq window-system 'x) ;;-> (define-key mouse-map x-button-right 'x-mouse-select) ;;-> (define-key mouse-map x-button-left 'x-mouse-set-mark) ;;-> (define-key mouse-map x-button-middle 'x-mouse-set-point) ;;-> ) ;;-> ((null window-system) ;;-> (global-set-mouse '(text left) 'mouse-drag-move-point) ;;-> (global-set-mouse '(text middle) 'mouse-set-mark-and-stuff) ;;-> (global-set-mouse '(text right) 'emacs-menu-eval) ;;-> ) ;;-> (t (error "Unrecognized window system for quick browsal")))) ;;-> ;;->;; (load "location")