App-Chart
view release on metacpan or search on metacpan
emacs/chartprog.el view on Meta::CPAN
(message "Chart subprocess died: %s" event))
(defun chartprog-process-kill ()
"An internal part of chartprog.el.
Kill chart subprocess."
(when chartprog-process-timer
(cancel-timer chartprog-process-timer)
(setq chartprog-process-timer nil))
(when chartprog-process
;; clear chartprog-process variable immediately, xemacs recurses to here
(let ((p chartprog-process))
(setq chartprog-process nil)
(set-process-sentinel p nil)
(set-process-filter p nil)
(delete-process p)
(kill-buffer (process-buffer p)))
;; go back to uninitialized to force a re-read on the contents if the
;; subprocess is restarted, that way any additions while we were away
;; will appear
(setq chartprog-completion-symbols-alist 'uninitialized)
(setq chartprog-symlist-alist 'uninitialized)
(setq chartprog-latest-cache (make-hash-table :test 'equal))))
;;-----------------------------------------------------------------------------
;; synchronous commands
(defvar chartprog-exec-synchronous-seq 0)
(defvar chartprog-exec-synchronous-got 0)
(defvar chartprog-exec-synchronous-result nil)
(defun chartprog-incoming-synchronous (got result)
"An internal part of chartprog.el.
Receive synchronize number GOT from Chart subprocess."
(setq chartprog-exec-synchronous-got got)
(setq chartprog-exec-synchronous-result result))
(defun chartprog-exec-synchronous (proc &rest args)
"An internal part of chartprog.el.
Call chart PROC (a symbol) with ARGS (lists, strings, etc).
Return the return value from that call, when it completes."
(setq chartprog-exec-synchronous-seq (1+ chartprog-exec-synchronous-seq))
(apply 'chartprog-exec 'synchronous chartprog-exec-synchronous-seq proc args)
(while (not (= chartprog-exec-synchronous-seq
chartprog-exec-synchronous-got)) ;; ignore old abandoned calls
(if (not (eq 'run (process-status chartprog-process)))
(error "Chart subprocess died"))
(accept-process-output chartprog-process))
chartprog-exec-synchronous-result)
;;-----------------------------------------------------------------------------
;; incoming from subprocess
(defun chartprog-incoming-update (symbol-list)
"An internal part of chartprog.el.
Receive advice from Chart subprocess that the symbols (strings)
in SYMBOL-LIST have updated.
Any cached data for these symbols in `chartprog-latest-cache' is
discarded.
Any of these symbols in the watchlist are re-read."
(chartprog-latest-cache-remove symbol-list)
(when (member chartprog-quote-symbol symbol-list)
(setq chartprog-quote-changed t))
(chartprog-debug-message "chartprog-quote-changed " chartprog-quote-symbol)
(let ((want-list (chartprog-intersection (chartprog-watchlist-symbol-list)
symbol-list)))
(chartprog-debug-message "watchlist want-list " want-list)
(if want-list
(chartprog-exec 'latest-get-list want-list))))
(defun chartprog-incoming-message (str)
"An internal part of chartprog.el.
Receive a free-form message STR from the Chart subprocess."
(message "%s" str))
(defun chartprog-incoming-error (errstr backtrace)
"An internal part of chartprog.el.
Receive an error message from the Chart subprocess.
ERRSTR is a string.
BACKTRACE is either a string or nil."
(when backtrace
(with-current-buffer (get-buffer-create "*chartprog-process-backtrace*")
(let ((follow (= (point) (point-max))))
(save-excursion
(goto-char (point-max))
(insert "-------------------------------------------------------------------------------\n")
(insert backtrace))
(when follow
(goto-char (point-max))))))
(message "%s" errstr))
;;-----------------------------------------------------------------------------
;; symbols completion
(defvar chartprog-symbol-history nil
"History list of Chart symbols entered by the user.")
(defun chartprog-minibuffer-local-completion-map ()
"An internal part of chartprog.el.
Return a keymap which is like `minibuffer-local-completion-map'
but with <SPACE> self-inserting.
Chart symbols can contain spaces, so <SPACE> is best as an
ordinary insert, not a completion like the default in
`minibuffer-local-completion-map'."
;; `minibuffer-local-completion-map' might change so must
;; `set-keymap-parent' each time, and the keymap is small enough that may
;; as well create a whole fresh one each time
(let ((m (make-sparse-keymap)))
(set-keymap-parent m minibuffer-local-completion-map)
(define-key m " " 'self-insert-command)
m))
(defvar chartprog-completion-symbols-alist 'uninitialized
"An internal part of chartprog.el.
emacs/chartprog.el view on Meta::CPAN
(completion-ignore-case t))
(let ((name (completing-read "Symlist: "
'chartprog-symlist-completion-handler
nil ;; pred
t ;; require-match
nil ;; initial-input
'chartprog-symlist-history)))
(cadr (assoc name (chartprog-symlist-alist))))))
;;-----------------------------------------------------------------------------
;; watchlist funcs
(defvar chartprog-watchlist-current-symlist 'favourites
"An internal part of chartprog.el.
The key of the current symlist being displayed in the watchlist.
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)))
emacs/chartprog.el view on Meta::CPAN
(defun chartprog-watchlist-symlist (symlist)
"Select SYMLIST to view."
(interactive (list (chartprog-completing-read-symlist)))
(unless (eq symlist chartprog-watchlist-current-symlist)
(chartprog-exec 'get-symlist symlist))
(setq chartprog-watchlist-current-symlist symlist))
(defun chartprog-watchlist-add (symbol)
"Add a symbol to the watchlist (after the current one).
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)
( run in 0.633 second using v1.01-cache-2.11-cpan-39bf76dae61 )