;;; sysmon.el --- System Monitor on Emacs  -*- lexical-binding: nil -*-
;;;
;;; Version: 2026/05/01
;;;
;;; Install
;;;  copy sysmon.el to /usr/share/emacs/site-lisp/.
;;;
;;; Setting
;;;  add to .emacs
;;;  ----
;;;  (require 'sysmon)
;;;  ----
;;;
;;; Start and Stop
;;;  M-x sysmon-start
;;;  M-x sysmon-stop
;;;

;;; Code:

(require 'svg)

(defcustom sysmon-plotchar        ?|
  "plot charactor" :group 'sysmon :type 'char)
(defcustom sysmon-disp-faceprop  nil
  "display color" :group 'sysmon  :type 'face-properties)
(defcustom sysmon-plot-faceprop  nil
  "plot color" :group 'sysmon :type 'face-properties)
(defcustom sysmon-update-interval 1.0
  "update interval" :group 'sysmon :type 'number)
(defcustom sysmon-drawcancel-threshold 60000
  "draw cancel threshold" :group 'sysmon :type 'integer)

(defcustom sysmon-enable-svg-draw nil
  "draw SVG drawing" :group 'sysmon :type 'boolean)
(defcustom sysmon-svg-graph-draw-propaties
  '(:fill-color     "#dbebff"
    :fill-opacity   "1.0"
    :stroke-width   "1"
    :stroke-color   "#0067ff"
    :stroke-opacity "1.0")
  "SVG graph draw propaties" :group 'sysmon :type 'svg-properties)

(defcustom sysmon-svg-load-text-draw-propaties
  '(:font-size   "20"
    :fill        "#0000ff"
    :stroke      "#0000ff"
    :opacity     "0.7"
    :font-family "terminal"
    :x           "10"
    :y           "20"
    :stroke-width "0")
  "SVG load text draw propaties" :group 'sysmon :type 'svg-properties)

(defvar sysmon-buffername "*System-Monitor*"
  "sysmon buffer name")
(defvar sysmon-timer nil
  "sysmon timer")

(defvar sysmon-mode-line-format
  '("    "
    mode-line-frame-identification
    mode-line-buffer-identification))

(defvar sysmon-prev_cpustat nil)
(defvar sysmon-rate-buffer  nil)
(defvar sysmon-disable-fitwindow nil)

(defvar sysmon-local-map nil)

(defun sysmon-start (&optional othwin)
  "start sysmon"
  (interactive)
  (progn
    (if (or (file-readable-p "/proc/stat")
            (string-search "cpu " (shell-command-to-string
                                   "cat /proc/stat")))
        (progn
          (setq sysmon-rate-buffer (list 0.0))
          (setq sysmon-prev_cpustat nil)
          (if sysmon-timer (cancel-timer sysmon-timer))
          (setq sysmon-timer (run-with-timer t sysmon-update-interval 'sysmon-main))
          (let ((selected))
            (setq selected (selected-window))
            (if othwin
                (switch-to-buffer-other-window sysmon-buffername)
              (switch-to-buffer sysmon-buffername))
            (setq sysmon-local-map (make-keymap))
            (define-key sysmon-local-map "q"  'sysmon-stop)
            (define-key sysmon-local-map "t"  'sysmon-toggle-svg-display)
            (use-local-map sysmon-local-map)
            (select-window selected)))
      (message "Can not open /proc/stat")
      )
    ))

(defun sysmon-start-other-window ()
  "start sysmon"
  (interactive)
  (sysmon-start t))

(defun sysmon-stop ()
  "stop sysmon"
  (interactive)
  (if sysmon-timer
      (progn
        (cancel-timer sysmon-timer)
        (setq sysmon-timer nil)
        (kill-buffer sysmon-buffername))))

(defun sysmon-main ()
  (with-current-buffer (get-buffer-create sysmon-buffername)
    (let ((linebuf))

      (setq truncate-lines t)
      (setq cursor-type nil)
      (read-only-mode 0)
      (buffer-disable-undo)
      (erase-buffer)

      (if (eq system-type 'windows-nt)
          (setq linebuf (split-string (shell-command-to-string "cat /proc/stat") "\n"))
        (with-temp-buffer
          (insert-file-contents "/proc/stat")
          (setq linebuf (split-string (buffer-string) "\n"))))

      (dolist (line linebuf)
        (if (string-match "^cpu " line)
            (let* ((field (split-string line))
                   (cpustat (list (float (string-to-number (nth 1 field)))
                                  (float (string-to-number (nth 2 field)))
                                  (float (string-to-number (nth 3 field)))
                                  (float (string-to-number (nth 4 field))))))

              (if sysmon-prev_cpustat
                  (let* ((dif_user (- (nth 0 cpustat) (nth 0 sysmon-prev_cpustat)))
                         (dif_nice (- (nth 1 cpustat) (nth 1 sysmon-prev_cpustat)))
                         (dif_sys  (- (nth 2 cpustat) (nth 2 sysmon-prev_cpustat)))
                         (dif_idle (- (nth 3 cpustat) (nth 3 sysmon-prev_cpustat)))
                         (sum (+ dif_user dif_nice dif_sys dif_idle))
                         (canvas nil)
                         )
                    (if (and sysmon-enable-svg-draw
                             (window-system)
                             (image-type-available-p 'svg))
                        (progn
                          (setq canvas (sysmon-build-svg-graph
                                        (/ (* 100.0 (+ dif_user dif_nice dif_sys)) sum)
                                        (/ (* 100.0 dif_sys ) sum)))
                          (insert-image (nth 0 canvas)))
                      (progn
                        (insert (propertize
                                 (format "total: %6.2f%% sys: %6.2f%%\n"
                                         (/ (* 100.0 (+ dif_user dif_nice dif_sys)) sum)
                                         (/ (* 100.0 dif_sys ) sum))
                                 'face sysmon-disp-faceprop))
                        (setq canvas (sysmon-build-graph (/ (* 100.0 (+ dif_user dif_nice dif_sys)) sum)))
                        (if (not (nth 1 canvas)) ;;描画cancelではない時
                            (insert (propertize
                                     (format "%s" (nth 0 canvas))
                                             'face sysmon-plot-faceprop)))
                      ))
                    ))
              (setq sysmon-prev_cpustat cpustat)
              )
          ))
      (goto-char (point-min))
      (setq mode-line-format sysmon-mode-line-format)
      (read-only-mode 1)
      )
    ))

(defun sysmon-build-graph (load-rate)
  (let ((canvas-w
         (if (or (eq (window-system) nil) sysmon-disable-fitwindow)
             (window-body-width  (get-buffer-window sysmon-buffername t))
           (/ (* (frame-char-width)
                 (window-body-width  (get-buffer-window sysmon-buffername t)))
              (default-font-width))))
        (canvas-h
         (if (or (eq (window-system) nil) sysmon-disable-fitwindow)
             (- (window-body-height (get-buffer-window sysmon-buffername t)) 1)
           (- (/ (* (frame-char-height)
                    (window-body-height (get-buffer-window sysmon-buffername t)))
                 (default-font-height))
              1)))
        (drawcancel nil)
        (canvas ""))

    (setq sysmon-rate-buffer (last (append sysmon-rate-buffer (list load-rate)) (- canvas-w 1)))
    (if (and (< 0 canvas-w) (< 0 canvas-h))
        (let ((line)
              (posx 0))
          (if (> (* canvas-w canvas-h) sysmon-drawcancel-threshold)
              (setq drawcancel t)
            (let ((plotmbchar (char-to-string sysmon-plotchar)))
              (dotimes (n (- canvas-w 1))
                (setq line (concat line " ")))
              (setq line (concat line "\n"))
              (dotimes (n canvas-h)
                (setq canvas (concat canvas line)))
              (dolist (rate sysmon-rate-buffer)
                (dotimes (n (* (float canvas-h) (/ rate 100.0)))
                  (let ((strpos (+ (* (- (- canvas-h 1) n) canvas-w) posx)))
                    (setq canvas
                          (concat
                           (substring canvas 0 strpos)
                           plotmbchar
                           (substring canvas (1+ strpos))))
                    )
                  )
                (setq posx (+ posx 1))
                ))
            )
          ))
    (list canvas drawcancel)
    ))

(defun sysmon-build-svg-graph (load-rate sys-load-rate)
  (let* ((canvas-w
          (if (or (eq (window-system) nil) sysmon-disable-fitwindow)
              (window-body-width  (get-buffer-window sysmon-buffername t))
            (/ (* (frame-char-width)
                  (window-body-width  (get-buffer-window sysmon-buffername t)))
               (default-font-width))))
         (canvas-h
          (if (or (eq (window-system) nil) sysmon-disable-fitwindow)
              (- (window-body-height (get-buffer-window sysmon-buffername t)) 1)
            (- (/ (* (frame-char-height)
                     (window-body-height (get-buffer-window sysmon-buffername t)))
                  (default-font-height))
               1)))
         (drawcancel nil)

         (win  (get-buffer-window sysmon-buffername t))
         (size (window-inside-pixel-edges win))
         (svg-width  (+ (- (nth 2 size) (nth 0 size)) 1))
         (svg-height (+ (- (nth 3 size) (nth 1 size)) 1))

         (svg-canvas (svg-create svg-width svg-height :stroke-width 1))
         (svg-poly-list (list (cons 0 (- svg-height 1))))
         )

    (setq sysmon-rate-buffer (last (append sysmon-rate-buffer (list load-rate)) (- canvas-w 1)))

    (let ((x 0)
          (xdist (/ svg-width canvas-w))
          )
      (dolist (rate sysmon-rate-buffer)
        (setq svg-poly-list
              (append svg-poly-list
                      (list (cons x (- svg-height (* (float svg-height) (/ rate 100.0)))))))
        (setq x (+ x xdist))
        )
      (setq svg-poly-list (append svg-poly-list (list (cons (- x xdist) (- svg-height 1)))))
      (sysmon-svg-polyline svg-canvas
                    svg-poly-list
                    sysmon-svg-graph-draw-propaties)
      (sysmon-svg-text
       svg-canvas (format "total: %6.2f%% sys: %6.2f%%\n" load-rate sys-load-rate)
       sysmon-svg-load-text-draw-propaties)
      )

    (list (svg-image svg-canvas :scale 1) drawcancel)
    ))

(defun sysmon-svg-polyline (svg points arglist)
  "Create a polyline going through POINTS on SVG.
POINTS is a list of x/y pairs."
  (svg--append
   svg
   (dom-node
    'polyline
    `((points . ,(mapconcat (lambda (pair)
                              (format "%s %s" (car pair) (cdr pair)))
                            points
                            ", "))
      ,@(svg--arguments svg arglist)))))

(defun sysmon-svg-text (svg text arglist)
  "Add TEXT to SVG."
  (svg--append
   svg
   (dom-node
    'text
    `(,@(svg--arguments svg arglist))
    text)))

(defun sysmon-toggle-svg-display ()
  "toggle SVG display"
  (interactive)
  (setq sysmon-enable-svg-draw (not sysmon-enable-svg-draw)))

(provide 'sysmon)
