code.delx.au - gnu-emacs-elpa/blob - packages/notes-mode/notes-index-mode.el

   1 ;;; notes-index-mode.el --- Index manipulation for notes-mode
   2
   3 ;; Copyright (C) 1994-1998,2012  Free Software Foundation, Inc.
   4
   5 ;; Author: <johnh@isi.edu>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;;; Code:
  25
  26 (require 'notes-variables)
  27 (require 'notes-aux)
  28
  29
  30 (defvar notes-index-mode-map
  31   (let ((map (make-sparse-keymap)))
  32     ;; There were bindings to make mouse-1 do pointer following,
  33     ;; but I removed it because all the rest of emacs uses mouse-2.
  34     ;; If you want them, add them with notes-index-mode-hook.
  35     (notes-platform-bind-mouse map 'mouse-2 'notes-index-mouse-follow-link)
  36     (notes-platform-bind-mouse map 'S-mouse-2 'notes-index-mouse-follow-link-other-window)
  37     (define-key map "\r" 'notes-index-follow-link)
  38     (define-key map "\C-c\C-s" 'notes-summarize-subject)
  39     (define-key map "o" 'notes-index-link)
  40     map))
  41
  42
  43 (defvar notes-index-lazy-message-old-time 0)
  44
  45 (defun notes-index-lazy-percent-message (text fraction whole)
  46   "Put up a message occasionally.
  47 Displays TEXT (a format string), with FRACTION of WHOLE
  48 shown as a percentage.  (Read the code to see what this
  49 cryptic statement means.)"
  50   (if (= notes-index-lazy-message-old-time
  51          (setq notes-index-lazy-message-old-time (+ 1 (nth 1 (current-time)))))
  52       nil
  53     (message text (/ (* fraction 100) whole))))
  54
  55 (defun notes-index-parse-buffer ()
  56   "Parse a notes-index buffer, fontifying and building subject completion.
  57
  58 If fontification is enabled, subjects will be emboldened
  59 and dates will be mouse-highlighted.
  60
  61 In any event a subject completion table will be built.
  62
  63 This routine works by calling either \[notes-index-parse-buffer-uncached]
  64 or \[notes-index-parse-buffer-cached] (if possible)."
  65   (interactive)
  66   (let
  67       ((inhibit-read-only t))
  68     (if (and (file-exists-p (expand-file-name "index_cache.el" notes-dir))
  69              (file-newer-than-file-p
  70               (expand-file-name "index_cache.el" notes-dir)
  71               (expand-file-name "index" notes-dir)))
  72         (progn
  73           (load (expand-file-name "index_cache" notes-dir))
  74           (notes-index-parse-buffer-cached))
  75       ;; cache miss
  76       (message "notes-index-parse-buffer: cache is not present or is not up-to-date")
  77       (notes-index-parse-buffer-uncached))
  78     ;; clean some things up
  79     (message "")
  80     (set-buffer-modified-p nil)))
  81
  82 (defun notes-index-parse-buffer-uncached ()
  83   "Parse a notes-index buffer, fontifying and building subject completion.
  84
  85 If fontification is enabled, subjects will be emboldened
  86 and dates will be mouse-highlighted.
  87
  88 In any event a subject completion table will be built.
  89
  90 Tenses passive will be."
  91   (interactive)
  92   (save-excursion
  93     (let ((start (point-min))
  94           end subject)
  95       ;; prepare the way
  96       (if notes-use-font-lock
  97           ;; FIXME: That's quite drastic!  What is this trying to do?
  98           (set-text-properties (point-min) (point-max) nil))
  99       ;; There used to be problem that we used a fixed obarray length,
 100       ;; creating a lot of hash collisions.  Now we dynamically compute it
 101       ;; by rounding up the number of lines to the next power of 8.
 102       (if (and notes-mode-complete-subjects (not notes-subject-table))
 103           (setq notes-subject-table (make-vector
 104                                      (- (expt
 105                                       8
 106                                       (length
 107                                        (format
 108                                         "%o"
 109                                         (count-lines
 110                                          (point-min)
 111                                          (point-max)))))
 112                                         1)
 113                                      0)))
 114       ;; do it
 115       (goto-char start)
 116       (while (< start (point-max))
 117         ;; find the end-of-line
 118         (end-of-line)
 119         (setq end (point))
 120         (goto-char start)
 121
 122         ;; find the subject
 123         (while (not (eq (following-char) ?\ ))
 124           (skip-chars-forward "^:" end)
 125           (forward-char))
 126         (backward-char)
 127         (if notes-subject-table
 128             (intern (buffer-substring start (point)) notes-subject-table))
 129         (notes-index-lazy-percent-message "Notes-index'ing (%d%%)..." start (point-max))
 130
 131         (if notes-use-font-lock
 132             (progn
 133               ;; highlight the title
 134               (put-text-property start (point) 'face notes-bold-face)
 135               (if notes-index-fontify-dates
 136                   (progn
 137                     ;; now highlight each date
 138                     (skip-chars-forward "^0-9" end)
 139                     (while (looking-at "[0-9]")
 140                       (setq start (point))
 141                       (skip-chars-forward "0-9")
 142                       (put-text-property start (point) 'mouse-face 'highlight)
 143                       (skip-chars-forward "^0-9" end))))))
 144         ;; set up for next line
 145         (forward-line 1)
 146         (setq start (point))))))
 147
 148
 149 (defun notes-index-date-search (start end iter-proc done-proc done-arg)
 150   "Iterate over a notes-index entry bounded by START to END.
 151 Iteration is done by (ITER-PROC END), which leaves match 0
 152 set to what we're looking for.
 153 A match terminates iteration if (DONE-PROC match DONE-ARG) is non-nil.
 154 Returns the buffer position of a successful hit, or nil."
 155   (goto-char start)
 156   (let (stop)
 157     (while (and (not stop)
 158                 (funcall iter-proc end))
 159       (if (funcall done-proc (match-string 0) done-arg)
 160           (setq stop (goto-char (match-beginning 0)))))
 161     stop))
 162
 163
 164 (defun notes-index-goto-date (date &optional direction)
 165   "Goto the DATE in the current line of the index file, modified by DIRECTION.
 166 If DIRECTION is `this', go there.
 167 If DIRECTION is `next' or `prev', go to the corresponding entry.
 168 If the entry doesn't exist, then go to the nearest entry according
 169 to DIRECTION (and the next one if DIRECTION is `this')."
 170   (cond
 171    ((eq direction 'prev)
 172     (notes-index-date-search
 173      (line-end-position) (line-beginning-position)
 174      (function (lambda (end) (re-search-backward notes-file-regexp end t)))
 175      (function (lambda (trial target) (string-lessp trial target)))
 176      date))
 177    ((eq direction 'next)
 178     (notes-index-date-search
 179      (line-beginning-position) (line-end-position)
 180      (function (lambda (end) (re-search-forward notes-file-regexp end t)))
 181      (function (lambda (trial target) (string-lessp target trial)))
 182      date))
 183    (t
 184     (notes-index-date-search
 185      (line-beginning-position) (line-end-position)
 186      (function (lambda (end) (re-search-forward notes-file-regexp end t)))
 187      (function (lambda (trial target) (string-equal trial target)))
 188      date))))
 189
 190 (defun notes-index-link (link &optional tag where)
 191   "* Follow a notes-index LINK.
 192 Optionally takes a subject TAG and
 193 WHERE (`otherwindow' or nil) to open the new file."
 194   (interactive "sNotes-index link: ")
 195   (notes-w3-url (notes-file-to-url link tag) where t))
 196
 197 ;;;###autoload
 198 (defun notes-index-todays-link ()
 199   "* Open the notes file for today."
 200   (interactive)
 201   (notes-index-link (format-time-string notes-file-form (current-time))))
 202
 203 (defun notes-index-follow-link (pt &optional where)
 204   "Follow a link at PT in notes-index-mode.
 205 The link is taken from the location PT,
 206 and the new information is shown WHERE (either `otherwindow' or nil)."
 207   (interactive "d")
 208   (save-excursion
 209     (let (start date tag)
 210       ;; determine the date
 211       (skip-chars-backward "0-9")
 212       (setq start (point))
 213       (if (not (re-search-forward notes-file-regexp (+ (point) 6) t))
 214           (error "Not on notes-index-mode link."))
 215       (setq date (match-string 0))
 216       ;; pick out the tag
 217       (beginning-of-line)
 218       (if (not (re-search-forward "^\\([^:]*\\):" start t))
 219           (error "Not on notes-index-mode link line."))
 220       (setq tag (match-string 1))
 221       ;; make and process the url
 222       (notes-index-link date tag where))))
 223
 224 (defun notes-index-mouse-follow-link (e)
 225   "Handle a mouse click in notes-index-mode."
 226   (interactive "e")
 227   (mouse-set-point e)
 228   (notes-index-follow-link (point) nil))
 229
 230 (defun notes-index-mouse-follow-link-other-window (e)
 231   "Handle a mouse click in notes-index-mode (other-window)."
 232   (interactive "e")
 233   (mouse-set-point e)
 234   (notes-index-follow-link (point) 'otherwindow))
 235
 236 (defun notes-index-extract-subject ()
 237   "Extract the notes-index subject for the current line."
 238   (save-excursion
 239     (beginning-of-line)
 240     (if (re-search-forward "^\\(.*\\): " (line-end-position) t)
 241         (match-string 1)
 242       nil)))
 243
 244 ;;;###autoload
 245 (define-derived-mode notes-index-mode special-mode "Notes-index"
 246   "Notes-index-mode with mouse support.
 247
 248 You may wish to change notes-bold-face and notes-use-font-lock.
 249
 250 There should be no need to add notes-index-mode to auto-mode-alist
 251 since the index generation functions add code to the index file
 252 which invokes notes-index-mode.
 253
 254 Key bindings are:
 255 \\{notes-index-mode-map}"
 256   (notes-platform-init)
 257
 258   (notes-index-parse-buffer)
 259
 260   (set (make-local-variable 'font-lock-defaults)
 261        '(notes-index-font-lock-keywords
 262          t nil nil beginning-of-line))
 263
 264   ;; No editing is allowed.
 265   (setq buffer-read-only t)
 266 )
 267
 268 (provide 'notes-index-mode)
 269 ;;; notes-index-mode.el ends here