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

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