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 not)."
 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