;;; notes-index-mode.el --- Index manipulation for notes-mode ;; Copyright (C) 1994-1998,2012 Free Software Foundation, Inc. ;; Author: ;; 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 3 of the License, 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. If not, see . ;;; Commentary: ;;; Code: (require 'notes-variables) (require 'notes-aux) (defvar notes-index-mode-map (let ((map (make-sparse-keymap))) ;; There were bindings to make mouse-1 do pointer following, ;; but I removed it because all the rest of emacs uses mouse-2. ;; If you want them, add them with notes-index-mode-hook. (notes-platform-bind-mouse map 'mouse-2 'notes-index-mouse-follow-link) (notes-platform-bind-mouse map 'S-mouse-2 'notes-index-mouse-follow-link-other-window) (define-key map "\r" 'notes-index-follow-link) (define-key map "\C-c\C-s" 'notes-summarize-subject) (define-key map "o" 'notes-index-link) map)) (defvar notes-index-lazy-message-old-time 0) (defun notes-index-lazy-percent-message (text fraction whole) "Put up a message occasionally. Displays TEXT (a format string), with FRACTION of WHOLE shown as a percentage. (Read the code to see what this cryptic statement means.)" (if (= notes-index-lazy-message-old-time (setq notes-index-lazy-message-old-time (+ 1 (nth 1 (current-time))))) nil (message text (/ (* fraction 100) whole)))) (defun notes-index-parse-buffer () "Parse a notes-index buffer, fontifying and building subject completion. If fontification is enabled, subjects will be emboldened and dates will be mouse-highlighted. In any event a subject completion table will be built. This routine works by calling either \[notes-index-parse-buffer-uncached] or \[notes-index-parse-buffer-cached] (if possible)." (interactive) (let ((inhibit-read-only t)) (if (and (file-exists-p (expand-file-name "index_cache.el" notes-dir)) (file-newer-than-file-p (expand-file-name "index_cache.el" notes-dir) (expand-file-name "index" notes-dir))) (progn (load (expand-file-name "index_cache" notes-dir)) (notes-index-parse-buffer-cached)) ;; cache miss (message "notes-index-parse-buffer: cache is not present or is not up-to-date") (notes-index-parse-buffer-uncached)) ;; clean some things up (message "") (set-buffer-modified-p nil))) (defun notes-index-parse-buffer-uncached () "Parse a notes-index buffer, fontifying and building subject completion. If fontification is enabled, subjects will be emboldened and dates will be mouse-highlighted. In any event a subject completion table will be built. Tenses passive will be." (interactive) (save-excursion (let ((start (point-min)) end subject) ;; prepare the way (if notes-use-font-lock ;; FIXME: That's quite drastic! What is this trying to do? (set-text-properties (point-min) (point-max) nil)) ;; There used to be problem that we used a fixed obarray length, ;; creating a lot of hash collisions. Now we dynamically compute it ;; by rounding up the number of lines to the next power of 8. (if (and notes-mode-complete-subjects (not notes-subject-table)) (setq notes-subject-table (make-vector (- (expt 8 (length (format "%o" (count-lines (point-min) (point-max))))) 1) 0))) ;; do it (goto-char start) (while (< start (point-max)) ;; find the end-of-line (end-of-line) (setq end (point)) (goto-char start) ;; find the subject (while (not (eq (following-char) ?\ )) (skip-chars-forward "^:" end) (forward-char)) (backward-char) (if notes-subject-table (intern (buffer-substring start (point)) notes-subject-table)) (notes-index-lazy-percent-message "Notes-index'ing (%d%%)..." start (point-max)) (if notes-use-font-lock (progn ;; highlight the title (put-text-property start (point) 'face notes-bold-face) (if notes-index-fontify-dates (progn ;; now highlight each date (skip-chars-forward "^0-9" end) (while (looking-at "[0-9]") (setq start (point)) (skip-chars-forward "0-9") (put-text-property start (point) 'mouse-face 'highlight) (skip-chars-forward "^0-9" end)))))) ;; set up for next line (forward-line 1) (setq start (point)))))) (defun notes-index-date-search (start end iter-proc done-proc done-arg) "Iterate over a notes-index entry bounded by START to END. Iteration is done by (ITER-PROC END), which leaves match 0 set to what we're looking for. A match terminates iteration if (DONE-PROC match DONE-ARG) is non-nil. Returns the buffer position of a successful hit, or nil." (goto-char start) (let (stop) (while (and (not stop) (funcall iter-proc end)) (if (funcall done-proc (match-string 0) done-arg) (setq stop (goto-char (match-beginning 0))))) stop)) (defun notes-index-goto-date (date &optional direction) "Goto the DATE in the current line of the index file, modified by DIRECTION. If DIRECTION is `this', go there. If DIRECTION is `next' or `prev', go to the corresponding entry. If the entry doesn't exist, then go to the nearest entry according to DIRECTION (and the next one if DIRECTION is `this')." (cond ((eq direction 'prev) (notes-index-date-search (line-end-position) (line-beginning-position) (function (lambda (end) (re-search-backward notes-file-regexp end t))) (function (lambda (trial target) (string-lessp trial target))) date)) ((eq direction 'next) (notes-index-date-search (line-beginning-position) (line-end-position) (function (lambda (end) (re-search-forward notes-file-regexp end t))) (function (lambda (trial target) (string-lessp target trial))) date)) (t (notes-index-date-search (line-beginning-position) (line-end-position) (function (lambda (end) (re-search-forward notes-file-regexp end t))) (function (lambda (trial target) (string-equal trial target))) date)))) (defun notes-index-link (link &optional tag where) "* Follow a notes-index LINK. Optionally takes a subject TAG and WHERE (`otherwindow' or nil) to open the new file." (interactive "sNotes-index link: ") (notes-w3-url (notes-file-to-url link tag) where t)) ;;;###autoload (defun notes-index-todays-link () "* Open the notes file for today." (interactive) (notes-index-link (format-time-string notes-file-form (current-time)))) (defun notes-index-follow-link (pt &optional where) "Follow a link at PT in notes-index-mode. The link is taken from the location PT, and the new information is shown WHERE (either `otherwindow' or nil)." (interactive "d") (save-excursion (let (start date tag) ;; determine the date (skip-chars-backward "0-9") (setq start (point)) (if (not (re-search-forward notes-file-regexp (+ (point) 6) t)) (error "Not on notes-index-mode link.")) (setq date (match-string 0)) ;; pick out the tag (beginning-of-line) (if (not (re-search-forward "^\\([^:]*\\):" start t)) (error "Not on notes-index-mode link line.")) (setq tag (match-string 1)) ;; make and process the url (notes-index-link date tag where)))) (defun notes-index-mouse-follow-link (e) "Handle a mouse click in notes-index-mode." (interactive "e") (mouse-set-point e) (notes-index-follow-link (point) nil)) (defun notes-index-mouse-follow-link-other-window (e) "Handle a mouse click in notes-index-mode (other-window)." (interactive "e") (mouse-set-point e) (notes-index-follow-link (point) 'otherwindow)) (defun notes-index-extract-subject () "Extract the notes-index subject for the current line." (save-excursion (beginning-of-line) (if (re-search-forward "^\\(.*\\): " (line-end-position) t) (match-string 1) nil))) ;;;###autoload (define-derived-mode notes-index-mode special-mode "Notes-index" "Notes-index-mode with mouse support. You may wish to change notes-bold-face and notes-use-font-lock. There should be no need to add notes-index-mode to auto-mode-alist since the index generation functions add code to the index file which invokes notes-index-mode. Key bindings are: \\{notes-index-mode-map}" (notes-platform-init) (notes-index-parse-buffer) (set (make-local-variable 'font-lock-defaults) '(notes-index-font-lock-keywords t nil nil beginning-of-line)) ;; No editing is allowed. (setq buffer-read-only t) ) (provide 'notes-index-mode) ;;; notes-index-mode.el ends here