view release on metacpan or  search on metacpan

emacs/chartprog.el  view on Meta::CPAN

;;; chartprog.el --- stock quotes using Chart.

;; Copyright 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Kevin Ryde

;; Author: Kevin Ryde <user42_kevin@yahoo.com.au>
;; Keywords: comm, finance
;; URL: http://user42.tuxfamily.org/chart/index.html

;; This file is part of Chart.
;;
;; Chart is free software; you can redistribute it and/or modify it under
;; the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 3, or (at your option) any later
;; version.
;;
;; Chart is distributed in the hope that it will be useful, but WITHOUT ANY
;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
;; details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Chart.  If not, see <http://www.gnu.org/licenses/>.


;;; Commentary:
;;
;; See section "Emacs" in the Chart manual for usage.


;;; Code:

(require 'timer) ;; for xemacs21

(eval-when-compile ;; for macros in emacs20
  (unless (and (fboundp 'declare)
               (fboundp 'dolist)
               (fboundp 'push))
    (require 'cl)))

(defvar bookmark-make-record-function)  ;; in bookmark.el


;;-----------------------------------------------------------------------------
;; customizations

;;;###autoload
(defgroup chartprog nil
  "Chart program interface."
  :prefix "chartprog-"
  :group 'applications
  :link '(custom-manual "(chart)Emacs"))

(defface chartprog-up
  `(;; plain "green" is too light to see against a white background
    (((class color) (background light))
     (:foreground "green4"))
    (((class color))
     (:foreground "green")))
  "Face for a Chart quote which is up."
  :group 'chartprog)

(defface chartprog-down
  `((((class color))
     (:foreground "red")))
  "Face for a Chart quote which is down."
  :group 'chartprog)

(defface chartprog-in-progress
  `((((class color) (background dark))
     (:foreground "cyan"))
    (((class color) (background light))
     (:foreground "blue")))
  "Face for Chart quote fetch in progress."
  :group 'chartprog)

(defcustom chartprog-watchlist-hook nil
  "*Hook called by `chart-watchlist'."
  :type  'hook
  :group 'chartprog)

;;-----------------------------------------------------------------------------

(defvar chartprog-debug nil)

(defun chartprog-debug-message (&rest args)
  (when chartprog-debug
    (let ((buffer (get-buffer-create "*chartprog-debug*")))
      (save-selected-window
        (let ((window (get-buffer-window buffer)))
          (if window (select-window window)))

        (with-current-buffer buffer

emacs/chartprog.el  view on Meta::CPAN

              (window-rows (mapcar (lambda (window)
                                     (cons window
                                           (count-lines (point-min)
                                                        (window-start window))))
                                   (get-buffer-window-list (current-buffer)))))
         (prog1 (progn ,@body)
           (dolist (pair window-rows)
             (goto-char (point-min))
             (forward-line (cdr pair))
             (set-window-start (car pair) (point)))

           (goto-char (point-min))
           (forward-line mark-row)
           (move-to-column mark-col)
           (and mark-pos
                (set-marker (mark-marker) (point)))

           (goto-char (point-min))
           (forward-line point-row)
           (move-to-column point-col))))))


(defun chartprog-intersection (x y)
  "An internal part of chartprog.el.
Return the intersection of lists X and Y, ie. elements common to both.
Elements are compared with `equal' and returned in the same order as they
appear in X.

This differs from the cl.el `intersection' in preserving the order of
elements for the return.  cl.el package doesn't preserve the order."
  (let (ret)
    (dolist (elem x) (if (member elem y) (push elem ret)))
    (nreverse ret)))

(defun chartprog-copy-tree-no-properties (obj)
  "An internal part of chartprog.el.
Return a copy of OBJ with no text properties on strings.
OBJ can be a list or other nested structure understood by
copy-sequence and mapcar."
  (cond ((stringp obj)
         (setq obj (copy-sequence obj))
         (set-text-properties 0 (length obj) nil obj)
         obj)
        ((sequencep obj)
         (mapcar 'chartprog-copy-tree-no-properties obj))
        (t
         obj)))


;;-----------------------------------------------------------------------------
;; subprocess

(defconst chartprog-protocol-version 102
  "An internal part of chartprog.el.
This must be the same as the number in App::Chart::EmacsMain, to
ensure cooperation with the sub-process.")

(defvar chartprog-process nil
  "An internal part of chartprog.el.
The running chart subprocess, or nil if not running.")
(defvar chartprog-process-timer nil
  "An internal part of chartprog.el.
Idle timer to kill chart subprocess when it's unused for a while.")

;; forward references
(defvar chartprog-completion-symbols-alist)
(defvar chartprog-latest-cache)
(defvar chartprog-symlist-alist)
(defvar chartprog-watchlist-map)
(defvar chartprog-watchlist-menu)
(defvar chartprog-quote-symbol)
(defvar chartprog-quote-changed)

(defun chartprog-exec (proc &rest args)
  "An internal part of chartprog.el.
Send the chart subprocess PROC (a symbol) with ARGS (lists,
strings, etc).  This is for an asynchronous or a no-reply message
to the subprocess.  See `chartprog-exec-synchronous' for
executing with reply."

  (unless (memq 'utf-8 (coding-system-list))
    (message "Loading mule-ucs for `utf-8' in XEmacs")
    (require 'un-define))

  ;; startup subprocess if not already running
  (unless chartprog-process
    (when (get-buffer " *chartprog subprocess*") ;; possible old buffer
      (kill-buffer " *chartprog subprocess*"))

    (setq chartprog-process
          (let ((process-connection-type nil)) ;; pipe
            (funcall 'start-process
                     "chartprog"
                     (get-buffer-create " *chartprog subprocess*")
                     "chart" "--emacs")))
    (set-process-coding-system chartprog-process 'utf-8 'utf-8)
    (set-process-filter chartprog-process 'chartprog-process-filter)
    (set-process-sentinel chartprog-process 'chartprog-process-sentinel)

    (if (eval-when-compile (fboundp 'set-process-query-on-exit-flag))
        (set-process-query-on-exit-flag chartprog-process nil) ;; emacs22
      (process-kill-without-query chartprog-process)) ;; emacs21

    (buffer-disable-undo (process-buffer chartprog-process)))

  ;; send this command
  (let ((str (concat (prin1-to-string
                      (chartprog-copy-tree-no-properties (cons proc args)))
                     "\n")))
    (chartprog-debug-message "\noutgoing " str)
    (process-send-string chartprog-process str))

  ;; start or restart idle timer
  (when chartprog-process-timer
    (cancel-timer chartprog-process-timer))
  (setq chartprog-process-timer (run-at-time "5 min" nil 'chartprog-process-kill)))

(defun chartprog-incoming-init (codeset protocol-version)
  "An internal part of chartprog.el.
Handle chart subprocess init message.
CODESET is always \"UTF-8\".
PROTOCOL-VERSION is the protocol number the subprocess is speaking, to be
matched against `chartprog-protocol-version'."

  (unless (= protocol-version chartprog-protocol-version)
    (when (get-buffer "*chartprog-watchlist*") ;; ignore if gone
      (with-current-buffer "*chartprog-watchlist*"
        (let ((inhibit-read-only t))
          (erase-buffer)
          (insert (format "Chart program doesn't match this chartprog.el.

  chartprog.el protocol:  %s
  chart program protocol: %s

Check your installation.
" chartprog-protocol-version protocol-version)))))

    (chartprog-process-kill)
    (error "Chart subprocess protocol version mismatch, got %s want %s"
           chartprog-protocol-version protocol-version)))

(defun chartprog-process-filter (proc str)
  "An internal part of chartprog.el.
The filter function for the chart subprocess per
`set-process-filter'.
STR is more text from the subprocess.
An incoming message is a Lisp form like (FOO (\"ABC\")).
When a complete form has arrived the corresponding
`chart-incoming-FOO' function is called."

  (with-current-buffer (process-buffer proc)
    (goto-char (point-max))
    (insert str)
    (while (progn
             ;; form begins with "(", ignore other diagnostics or whatever
             (goto-char (point-min))
             (skip-chars-forward "^(")
             (delete-region (point-min) (point))

             ;; see if a complete form has arrived
             (let ((form (condition-case nil
                             (read (process-buffer proc))
                           (error nil))))
               (when form
                 (delete-region (point-min) (point))

                 (chartprog-debug-message "incoming " form)
                 (apply (intern (concat "chartprog-incoming-"
                                        (symbol-name (car form))))
                        (cdr form)))

               ;; no more processing after `synchronous', let the result get
               ;; back to the caller before further asynch stuff is
               ;; processed (that further stuff deferred under a timer)
               (when (eq (car form) 'synchronous)
                 (run-at-time 0.0000001 nil
                              (lambda ()
                                (chartprog-process-filter chartprog-process "")))
                 (setq form nil))

               ;; process another form, perhaps
               form)))))

(defun chartprog-process-sentinel (proc event)
  "An internal part of chartprog.el.
The sentinel for the chart subprocess per `set-process-sentinel'.

The subprocess should stay alive forever, until we ask it to stop
by the `chartprog-process-timer, so any termination is
unexpected."
  (when (get-buffer "*chartprog-watchlist*")
    (with-current-buffer "*chartprog-watchlist*"
      (let ((inhibit-read-only t))
        (save-excursion
          (goto-char (point-min))
          (when (looking-at "\\s-*Starting")
            (erase-buffer))
          (insert (format "\nSubprocess died: %s\n\n" event))))))
  (chartprog-process-kill)
  (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))