Mercurial > hg > xemacs-beta

comparison lisp/hyperbole/wrolo.el @ 24:4103f0995bd7 r19-15b95

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b95
author cvs
date Mon, 13 Aug 2007 08:51:03 +0200
parents 376386a54a3c
children c53a95d3c46d
comparison
equal deleted inserted replaced
23:0edd3412f124 24:4103f0995bd7
6 ;; SUMMARY: Hierarchical, multi-file, easy to use rolodex system 6 ;; SUMMARY: Hierarchical, multi-file, easy to use rolodex system
7 ;; USAGE: GNU Emacs Lisp Library 7 ;; USAGE: GNU Emacs Lisp Library
8 ;; KEYWORDS: hypermedia, matching 8 ;; KEYWORDS: hypermedia, matching
9 ;; 9 ;;
10 ;; AUTHOR: Bob Weiner 10 ;; AUTHOR: Bob Weiner
11 ;; ORG: Motorola Inc. 11 ;;
12 ;; ORG: InfoDock Associates. We sell corporate support and development
13 ;; contracts for InfoDock, Emacs and XEmacs.
14 ;; E-mail: <info@infodock.com> Web: http://www.infodock.com
15 ;; Tel: +1 408-243-3300
12 ;; 16 ;;
13 ;; ORIG-DATE: 7-Jun-89 at 22:08:29 17 ;; ORIG-DATE: 7-Jun-89 at 22:08:29
14 ;; LAST-MOD: 31-Oct-95 at 18:39:54 by Bob Weiner 18 ;; LAST-MOD: 17-Feb-97 at 15:32:20 by Bob Weiner
15 ;; 19 ;;
16 ;; This file is part of Hyperbole. 20 ;; This file is part of Hyperbole.
17 ;; Available for use and distribution under the same terms as GNU Emacs. 21 ;; Available for use and distribution under the same terms as GNU Emacs.
18 ;; 22 ;;
19 ;; Copyright (C) 1989, '90, '91, '92, '95 Free Software Foundation, Inc. 23 ;; Copyright (C) 1989, '90, '91, '92, '95 Free Software Foundation, Inc.
20 ;; Developed with support from Motorola Inc. 24 ;; Copyright (C) 1996 InfoDock Associates
21 ;; 25 ;;
22 ;; DESCRIPTION: 26 ;; DESCRIPTION:
23 ;; 27 ;;
24 ;; The `put whatever you feel like into it' rolodex. 28 ;; The `put whatever you feel like into it' rolodex.
25 ;; 29 ;;
221 "Format string to use when adding an entry with e-mail addr from a mail msg. 225 "Format string to use when adding an entry with e-mail addr from a mail msg.
222 It must contain a %s indicating where to put the entry name and a second 226 It must contain a %s indicating where to put the entry name and a second
223 %s indicating where to put the e-mail address.") 227 %s indicating where to put the e-mail address.")
224 228
225 (defvar rolo-file-list 229 (defvar rolo-file-list
226 (if (memq system-type '(ms-windows windows-nt ms-dos)) 230 (if hyperb:microcruft-os-p
227 '("c:/_rolodex.otl") '("~/.rolodex.otl")) 231 '("c:/_rolodex.otl") '("~/.rolodex.otl"))
228 "*List of files containing rolodex entries. 232 "*List of files containing rolodex entries.
229 The first file should be a user-specific rolodex file, typically in the home 233 The first file should be a user-specific rolodex file, typically in the home
230 directory. The second file is often a shared, group-specific rolodex file. 234 directory. The second file is often a shared, group-specific rolodex file.
231 235
344 nil 348 nil
345 (insert (or entry-level (concat level "*")) 349 (insert (or entry-level (concat level "*"))
346 (if (string= entry-spc "") " " entry-spc) 350 (if (string= entry-spc "") " " entry-spc)
347 name "\n") 351 name "\n")
348 (backward-char 1)) 352 (backward-char 1))
349 (widen) 353 ;; Rolo-to-buffer may move point from its desired location, so
350 (rolo-to-buffer (current-buffer)) 354 ;; restore it.
351 ;; Fixes non-display update bug when buf is on screen before 355 (let ((opoint (point)))
352 ;; interactive command invocation. 356 (widen)
353 (goto-char (point)) 357 (rolo-to-buffer (current-buffer))
358 (goto-char opoint))
354 (if (interactive-p) 359 (if (interactive-p)
355 (message "Edit entry at point."))))) 360 (message "Edit entry at point.")))))
356 361
357 ;;;###autoload 362 ;;;###autoload
358 (defun rolo-display-matches (&optional display-buf return-to-buffer) 363 (defun rolo-display-matches (&optional display-buf return-to-buffer)
419 (beep) 424 (beep)
420 (rolo-to-buffer (or (get-file-buffer (car file-list)) 425 (rolo-to-buffer (or (get-file-buffer (car file-list))
421 (find-file-noselect (car file-list)))) 426 (find-file-noselect (car file-list))))
422 (setq buffer-read-only nil)) 427 (setq buffer-read-only nil))
423 (widen) 428 (widen)
424 ;; Fixes display update bug in some Emacs versions. When buf is 429 ;; Rolo-to-buffer may have moved point from its desired location, so
425 ;; on screen before interactive command invocation, point is not 430 ;; restore it.
426 ;; moved to proper location.
427 (if found-point (goto-char found-point))))) 431 (if found-point (goto-char found-point)))))
428 432
429 (defun rolo-edit-entry () 433 (defun rolo-edit-entry ()
430 "Edit the source entry of the rolodex match buffer entry at point. 434 "Edit the source entry of the rolodex match buffer entry at point.
431 Returns entry name if found, else nil." 435 Returns entry name if found, else nil."
669 groupings at the given level. LEVEL-REGEXP should simply match the text of 673 groupings at the given level. LEVEL-REGEXP should simply match the text of
670 any rolodex entry of the given level, not the beginning of a line (^); an 674 any rolodex entry of the given level, not the beginning of a line (^); an
671 example, might be (regexp-quote \"**\") to match level two. Returns number 675 example, might be (regexp-quote \"**\") to match level two. Returns number
672 of groupings sorted." 676 of groupings sorted."
673 (interactive "sRolodex file to sort: \nRegexp for level's entries: \nP") 677 (interactive "sRolodex file to sort: \nRegexp for level's entries: \nP")
674 (rolo-map-level 678 (let ((sort-fold-case t))
675 (function (lambda (start end) (sort-lines nil start end))) 679 (rolo-map-level
676 rolo-file 680 (function (lambda (start end) (sort-lines nil start end)))
677 level-regexp 681 rolo-file
678 max-groupings)) 682 level-regexp
683 max-groupings)))
679 684
680 (defun rolo-toggle-narrow-to-entry () 685 (defun rolo-toggle-narrow-to-entry ()
681 "Toggle between display of current entry and display of all matched entries. 686 "Toggle between display of current entry and display of all matched entries.
682 Useful when bound to a mouse key." 687 Useful when bound to a mouse key."
683 (interactive) 688 (interactive)
1114 (interactive) 1119 (interactive)
1115 (setq major-mode 'wrolo-mode 1120 (setq major-mode 'wrolo-mode
1116 mode-name "Rolodex") 1121 mode-name "Rolodex")
1117 (use-local-map wrolo-mode-map) 1122 (use-local-map wrolo-mode-map)
1118 ;; 1123 ;;
1124 (set-syntax-table wrolo-mode-syntax-table)
1125 ;;
1119 ;; Loads menus under non-tty InfoDock, XEmacs or Emacs19; does nothing 1126 ;; Loads menus under non-tty InfoDock, XEmacs or Emacs19; does nothing
1120 ;; otherwise. 1127 ;; otherwise.
1121 (and (not (featurep 'wrolo-menu)) hyperb:window-system 1128 (and (not (featurep 'wrolo-menu)) hyperb:window-system
1122 (or hyperb:lemacs-p hyperb:emacs19-p) (require 'wrolo-menu)) 1129 (or hyperb:lemacs-p hyperb:emacs19-p) (require 'wrolo-menu))
1123 ;; 1130 ;;
1157 Nil before a search is done. 1164 Nil before a search is done.
1158 String search expressions are converted to regular expressions.") 1165 String search expressions are converted to regular expressions.")
1159 1166
1160 (defvar *rolo-wconfig* nil 1167 (defvar *rolo-wconfig* nil
1161 "Saves frame's window configuration prior to a rolodex search.") 1168 "Saves frame's window configuration prior to a rolodex search.")
1169
1170 (defvar wrolo-mode-syntax-table nil
1171 "Syntax table used while in wrolo match mode.")
1172
1173 (if wrolo-mode-syntax-table
1174 ()
1175 (setq wrolo-mode-syntax-table (make-syntax-table text-mode-syntax-table))
1176 ;; Support syntactic selection of delimited e-mail addresses.
1177 (modify-syntax-entry ?< "(>" wrolo-mode-syntax-table)
1178 (modify-syntax-entry ?> ")<" wrolo-mode-syntax-table))
1162 1179
1163 (defvar wrolo-mode-map nil 1180 (defvar wrolo-mode-map nil
1164 "Keymap for the rolodex match buffer.") 1181 "Keymap for the rolodex match buffer.")
1165 1182
1166 (if wrolo-mode-map 1183 (if wrolo-mode-map