view release on metacpan or  search on metacpan

emacs/chartprog.el  view on Meta::CPAN

This is a symbol such as `favourites', or `user-1'.")

(defun chartprog-watchlist-find (symbol)
  "An internal part of chartprog.el.
Move point to line for Chart SYMBOL (a string).
Return non-nil if found.
Return nil and leave point unchanged if not found."
  (let ((oldpos (point))
        found)
    (goto-char (point-min))
    ;; continue while not found and can move forward a line
    (while (and (not (setq found (equal symbol (chartprog-watchlist-symbol))))
                (= 0 (forward-line))))
    (unless found
      (goto-char oldpos))
    found))

(defun chartprog-watchlist-symbol ()
  "An internal part of chartprog.el.
Return Char symbol (a string) on current watchlist line, or nil
if none."
  (get-text-property (point-at-bol) 'chartprog-symbol))

(defun chartprog-watchlist-symbol-list ()
  "An internal part of chartprog.el.
Return list of Chart symbols (strings) in watchlist buffer.
If no watchlist buffer then return nil."
  (and (get-buffer "*chartprog-watchlist*") ;; ignore if gone
       (with-current-buffer "*chartprog-watchlist*"
         (let (lst)
           (save-excursion
             (goto-char (point-min))
             (while (let ((symbol (chartprog-watchlist-symbol)))
                      (if symbol
                          (setq lst (cons symbol lst)))
                      (= 0 (forward-line)))))
           (nreverse lst)))))


;;-----------------------------------------------------------------------------
;; watchlist display

(defun chartprog-incoming-symlist-update (key-list)
  "An internal part of chartprog.el.
Receive advice from Chart subprocess that symlists KEY-LIST have updated.
KEY-LIST is a list of Lisp symbols."
  (if (and (get-buffer "*chartprog-watchlist*") ;; ignore if gone
           (memq chartprog-watchlist-current-symlist key-list))
      (chartprog-exec 'get-symlist chartprog-watchlist-current-symlist)))

(defun chartprog-incoming-latest-line-list (lst)
  "An internal part of chartprog.el.
Receive LST of latest elements (SYMBOL STR FACE HELP).
The watchlist buffer is updated with the new data."
  (when (get-buffer "*chartprog-watchlist*") ;; ignore if gone
    (with-current-buffer "*chartprog-watchlist*"
      (chartprog-save-row-col
        (let ((inhibit-read-only t))
          (dolist (elem lst) ;; elements (SYMBOL STR FACE)
            (when (chartprog-watchlist-find (car elem))
              (delete-region (point-at-bol) (point-at-eol))
              (insert (propertize (cadr elem)
                                  'chartprog-symbol (car elem)
                                  'face             (nth 2 elem)
                                  'help-echo        (nth 3 elem))))))))))

(defun chartprog-incoming-symlist-list (symlist symbol-list)
  "An internal part of chartprog.el.
SYMLIST is a Lisp symbol, a symlist key.
SYMBOL-LIST is a list of Chart symbols (strings) which are the
contents of that symlist."
  (when (and (get-buffer "*chartprog-watchlist*")              ;; ignore if gone
             (eq symlist chartprog-watchlist-current-symlist)) ;; or if stray response
    (with-current-buffer "*chartprog-watchlist*"
      (let (alst need)

        ;; build alst (SYMBOL . LINE-STRING) for existing lines
        (save-excursion
          (goto-char (point-min))
          (while (let ((symbol (chartprog-watchlist-symbol)))
                   (when symbol
                     (push (cons symbol
                                 (buffer-substring (point)
                                                   (1+ (point-at-eol))))
                           alst))
                   (= 0 (forward-line)))))

        ;; fill buffer, and use existing lines from alst
        (let ((inhibit-read-only t))
          (chartprog-save-row-col
            (erase-buffer)
            (dolist (symbol symbol-list)
              (insert (or (cdr (assoc symbol alst))
                          (progn
                            (setq need (cons symbol need))
                            (propertize (concat symbol "\n")
                                        'chartprog-symbol symbol)))))
            (unless symbol-list
              (if (chartprog-symlist-editable-p chartprog-watchlist-current-symlist)
                  (insert (format "\n\n(Empty list, use `%s' to add a symbol.)"
                                  (key-description
                                   (car (where-is-internal
                                         'chartprog-watchlist-add
                                         chartprog-watchlist-map)))))
                (insert (format "\n\n(Empty list.)"))))))
        (if need
            (chartprog-exec 'latest-get-list (nreverse need)))))))


;;-----------------------------------------------------------------------------
;; header-line-format hscrolling

(defconst chartprog-header-line-scrolling-align0
  (propertize " " 'display '((space :align-to 0)))
  "An internal part of chartprog.el.
An string which is space with align-to 0 property.")

(defvar chartprog-header-line-scrolling-str nil
  "An internal part of chartprog.el.
Buffer local full `header-line-format' string to be hscrolled.")

(defun chartprog-header-line-scrolling-align ()
  "An internal part of chartprog.el.
Return a string which will align to column 0 in a `header-line-format'."
  (if (string-match "^21\\." emacs-version)
      (and (display-graphic-p)
           (concat " "  ;; the fringe
                   (and (eq 'left (frame-parameter nil 'vertical-scroll-bars))
                        "  ")))  ;; left scrollbar
    ;; in emacs 22 and up align-to understands fringe and scrollbar
    chartprog-header-line-scrolling-align0))

(defun chartprog-header-line-scrolling-eval ()
  "An internal part of chartprog.el.
Install hscrolling header line updates on the windows of the current frame."
  (concat (chartprog-header-line-scrolling-align)
          (substring chartprog-header-line-scrolling-str
                     (min (length chartprog-header-line-scrolling-str)
                          (window-hscroll)))))

(defun chartprog-header-line-scrolling (str)
  "An internal part of chartprog.el.
Set STR as `header-line-format' and make it follow any hscrolling."
  (set (make-local-variable 'chartprog-header-line-scrolling-str) str)

emacs/chartprog.el  view on Meta::CPAN

SYMBOL is read from the minibuffer, with completion from the database symbols."
  (interactive (progn (chartprog-watchlist-want-edit)
                      (list (chartprog-completing-read-symbol))))
  (chartprog-watchlist-want-edit)
  (unless (chartprog-watchlist-find symbol)
    (beginning-of-line)
    (forward-line)
    (chartprog-exec 'symlist-insert chartprog-watchlist-current-symlist
                    (count-lines (point-min) (point)) ;; position
                    (list symbol))
    (let ((inhibit-read-only t))
      (insert (propertize (concat symbol "\n") 'chartprog-symbol symbol)))
    (forward-line -1)
    (chartprog-exec 'latest-get-list (list symbol))
    (chartprog-exec 'request-symbols (list symbol))))

(defun chartprog-watchlist-yank ()
  "Yank a watchlist line.
Only lines from the watchlist buffer can be yanked
\(see `chartprog-watchlist-add' to insert an arbitrary symbol)."
  (interactive)
  (chartprog-watchlist-want-edit)
  (let ((str (current-kill 0 t)))
    (if (string-match "\n+\\'" str) ;; lose trailing newlines
        (setq str (replace-match "" t t str)))
    (let ((symbol-list (mapcar (lambda (line)
                                 (get-text-property 0 'chartprog-symbol line))
                               (split-string str "\n"))))
      (if (memq nil symbol-list)
          (error "Can only yank killed watchlist line(s)"))
      (beginning-of-line)
      (chartprog-exec 'symlist-insert chartprog-watchlist-current-symlist
                      (count-lines (point-min) (point)) ;; position
                      symbol-list)
      (let ((inhibit-read-only t))
        (yank)))))

(defun chartprog-watchlist-undo ()
  "Undo last edit in the watchlist."
  (interactive)
  (error "Sorry, not working yet")

  (chartprog-watchlist-want-edit)
  (let ((inhibit-read-only t))
    (undo)))

(defun chartprog-watchlist-refresh (arg)
  "Refresh watchlist quotes.
With a prefix ARG (\\[universal-argument]), refresh only current line.

For the Alerts list, all symbols with alert levels are refreshed,
and the list contents updated accordingly.  (So not merely those
already showing which are refreshed.)"

  (interactive "P")
  ;; updates from the subprocess will come with an in-progress face, but
  ;; apply that here explicitly to have it show immediately
  (if arg
      (progn ;; one symbol
        (let ((inhibit-read-only t))
          (add-text-properties (point-at-bol) (point-at-eol)
                               (list 'face 'chartprog-in-progress)))
        (chartprog-exec 'request-explicit (list (chartprog-watchlist-symbol))))
    (progn ;; whole list
      (let ((inhibit-read-only t))
        (add-text-properties (point-min) (point-max)
                             (list 'face 'chartprog-in-progress)))
      (chartprog-exec 'request-explicit-symlist chartprog-watchlist-current-symlist))))

(defun chartprog-watchlist-quit ()
  "Quit from the watchlist display."
  (interactive)
  (chartprog-process-kill)
  (kill-buffer nil))

;;;###autoload
(defun chart-watchlist ()
  "Chart watchlist display.

\\{chartprog-watchlist-map}
On a colour screen, face `chartprog-up' and face `chartprog-down' show
each line in green or red according to whether the last trade was
higher or lower than the previous close (ie. the change column
positive or negative).  Face `chartprog-in-progress' shows blue while
quotes are being downloaded.

Stock name and quote/last-trade times can be seen in a tooltip by
moving the mouse over each line.  The same can be seen on a text
terminal with `\\[chartprog-watchlist-detail]'."

  (interactive)
  (switch-to-buffer (get-buffer-create "*chartprog-watchlist*"))
  (when (save-excursion
          (goto-char (point-min))
          (or (looking-at "Subprocess died")
              (eq (point-min) (point-max))))

    (setq buffer-read-only nil)
    (erase-buffer)
    (insert "\nStarting chart subprocess ...\n")
    (sit-for 0) ;; redisplay
    (kill-all-local-variables)
    (use-local-map chartprog-watchlist-map)
    (setq major-mode       'chart-watchlist
          mode-name        "Watchlist"
          truncate-lines   t
          buffer-read-only t
          chartprog-watchlist-current-symlist 'favourites)
    (chartprog-header-line-scrolling
     "Symbol       Bid/Offer     Last  Change    Low    High    Volume   When   Note")

    (set (make-local-variable 'mode-line-buffer-identification)
         (append (default-value 'mode-line-buffer-identification)
                 '((:eval (chartprog-watchlist-mode-line-symlist-name)))))

    (set (make-local-variable 'bookmark-make-record-function)
         'chartprog-watchlist-bookmark-make-record)

    (when (fboundp 'make-local-hook)
      (make-local-hook 'kill-buffer-hook)) ;; for xemacs21
    (add-hook 'kill-buffer-hook 'chartprog-process-kill t t)