Browse Source

WIP

master
Damien Cassou 2 years ago
parent
commit
74099fed3b
Signed by: DamienCassou GPG Key ID: B68746238E59B548
1 changed files with 118 additions and 43 deletions
  1. +118
    -43
      netmacs.el

+ 118
- 43
netmacs.el View File

@ -30,14 +30,37 @@
;; Utility functions
(defun netmacs-string-num< (num1 num2)
(defun netmacs--string-num< (num1 num2)
"Compare the strings NUM1 and NUM2 as numbers.
The result is the one expected by `sort'."
(< (string-to-number num1)
(string-to-number num2)))
(defun netmacs--list (type &optional get-objects-fn)
"Display all objects matching TYPE in a table.
GET-OBJECTS-FN accepts a type and returns a list of objects
matching TYPE."
(let ((buffer (get-buffer-create
(format "*netmacs: %s*"
(netmacs--buffer-suffix-for-type type))))
(get-objects-fn (or get-objects-fn #'netmacs--objects-for-type)))
(with-current-buffer buffer
(let ((inhibit-read-only t)
(objects (funcall get-objects-fn type)))
(erase-buffer)
(funcall (netmacs--tabulated-mode-for-type type))
(setq tabulated-list-format (netmacs--tabulated-format type))
(setq tabulated-list-entries
(mapcar #'netmacs--object-to-row objects))
(setq-local revert-buffer-function
(lambda (&rest _) (netmacs--list type get-objects-fn)))
(tabulated-list-init-header)
(tabulated-list-print)))
(pop-to-buffer buffer)))
;; Tabulated lists configuration
;; Generic methods
(cl-defgeneric netmacs--tabulated-format (type)
"Return `tabulated-list-format' value for objects of type TYPE.")
@ -45,6 +68,23 @@ The result is the one expected by `sort'."
(cl-defgeneric netmacs--object-to-row (object)
"Convert OBJECT to a row following `netmacs--tabulated-format'.")
(cl-defgeneric netmacs--tabulated-mode-for-type (type)
"Return major mode's value for objects of type TYPE.")
(cl-defgeneric netmacs--object-at-point ()
"Return netmacs object at point."
(tabulated-list-get-id))
(cl-defgeneric netmacs--objects-for-type (type)
"Return a list of objects for TYPE.")
(cl-defgeneric netmacs--buffer-suffix-for-type (type)
"Return a string to display in netmacs buffer names for TYPE."
(symbol-name type))
;; Device
(cl-defmethod netmacs--tabulated-format ((_ (eql device)))
(vector (list "Name" 15 t)
(list "Type" 15 t)
@ -61,17 +101,20 @@ The result is the one expected by `sort'."
(libnetmacs-name connection)
"")))))
(cl-defmethod netmacs--tabulated-mode-for-type ((_ (eql device)))
#'netmacs-device-list-mode)
(cl-defmethod netmacs--objects-for-type ((_ (eql device)))
(libnetmacs-objects 'device))
;; Abstract connection
(cl-defmethod netmacs--tabulated-format ((_ (eql abstract-connection)))
(vector (list "Name" 30 t)
(list "Type" 15 t)
(list "Devices" 0 t)))
(cl-defmethod netmacs--tabulated-format ((_ (eql active-connection)))
(netmacs--tabulated-format 'abstract-connection))
(cl-defmethod netmacs--tabulated-format ((_ (eql connection)))
(netmacs--tabulated-format 'abstract-connection))
(cl-defmethod netmacs--object-to-row ((connection libnetmacs-abstract-connection))
(list connection
(vector (libnetmacs-name connection)
@ -80,10 +123,26 @@ The result is the one expected by `sort'."
(libnetmacs-connection-devices connection)
", "))))
(cl-defmethod netmacs--tabulated-mode-for-type ((_ (eql abstract-connection)))
#'netmacs-connection-list-mode)
(cl-defmethod netmacs--objects-for-type ((_ (eql abstract-connection)))
(let* ((active-connections (libnetmacs-objects 'active-connection))
(all-connections (libnetmacs-objects 'connection))
(other-connections (cl-set-difference
all-connections
active-connections
:test #'libnetmacs-connection-equal-p)))
(append active-connections
other-connections)))
;; Access-point
(cl-defmethod netmacs--tabulated-format ((_ (eql access-point)))
(vector (list "Name" 30 t)
(list "Signal" 15 #'netmacs-string-num<)
(list "Max bitrate" 15 #'netmacs-string-num<)))
(list "Signal" 15 #'netmacs--string-num<)
(list "Max bitrate" 15 #'netmacs--string-num<)))
(cl-defmethod netmacs--object-to-row ((access-point libnetmacs-access-point))
(list access-point
@ -94,54 +153,70 @@ The result is the one expected by `sort'."
(/ (libnetmacs-access-point-max-bitrate access-point) 1000))
" Mbit/s"))))
(defun netmacs--list (objects name type)
"Display OBJECTS in a table.
NAME will be part of the buffer name.
TYPE is the object type to display."
(let ((buffer (get-buffer-create
(format "*netmacs: %s*" name))))
(with-current-buffer buffer
(let ((inhibit-read-only t))
(erase-buffer)
(tabulated-list-mode)
(setq tabulated-list-format (netmacs--tabulated-format type))
(setq tabulated-list-entries
(mapcar #'netmacs--object-to-row objects))
(tabulated-list-init-header)
(tabulated-list-print)))
(pop-to-buffer buffer)))
(cl-defmethod netmacs--tabulated-mode-for-type ((_ (eql access-point)))
#'netmacs-access-point-list-mode)
;; Commands
(defun netmacs-activate-object-at-point (object)
"Connect OBJECT."
(interactive (list (netmacs--object-at-point)))
(let ((buffer (current-buffer)))
(libnetmacs-activate
object
(lambda (_) (revert-buffer buffer)))))
(defun netmacs-deactivate-object-at-point (object)
"Disconnect OBJECT."
(interactive (list (netmacs--object-at-point)))
(let ((buffer (current-buffer)))
(libnetmacs-deactivate
object
(lambda () (revert-buffer buffer)))))
;;;###autoload
(defun netmacs-list-devices ()
"Display all devices."
(interactive)
(netmacs--list (libnetmacs-objects 'device) "devices" 'device))
(netmacs--list 'device))
;;;###autoload
(defun netmacs-list-access-points (wifi-device)
"Display access-points of WIFI-DEVICE."
(interactive (list (or
(tabulated-list-get-id)
(libnetmacs-choose-object (libnetmacs-wifi-devices)))))
(netmacs--list
(libnetmacs-device-access-points wifi-device)
"access-points"
'access-point))
'access-point
(lambda (_) (libnetmacs-device-access-points wifi-device))))
;;;###autoload
(defun netmacs-list-connections ()
"Display all connections."
(interactive)
(let* ((active-connections (libnetmacs-objects 'active-connection))
(all-connections (libnetmacs-objects 'connection))
(other-connections (cl-set-difference
all-connections
active-connections
:test #'libnetmacs-connection-equal-p)))
(netmacs--list
(append active-connections
other-connections)
"connections"
'abstract-connection)))
(netmacs--list 'abstract-connection))
;; Modes
(defvar netmacs-tabulated-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "s" #'netmacs-activate-object-at-point)
(define-key map "k" #'netmacs-deactivate-object-at-point)
map))
(define-derived-mode netmacs-tabulated-list-mode tabulated-list-mode "netmacs-list"
"Abstract major mode for buffers displaying netmacs tabulated data.")
(define-derived-mode netmacs-device-list-mode netmacs-tabulated-list-mode "netmacs-devices"
"Major mode for buffers displaying netmacs device lists.")
(define-derived-mode netmacs-connection-list-mode netmacs-tabulated-list-mode "netmacs-connections"
"Major mode for buffers displaying netmacs connection lists.")
(define-derived-mode netmacs-access-point-list-mode netmacs-tabulated-list-mode "netmacs-access-points"
"Major mode for buffers displaying netmacs access-point lists.")
(provide 'netmacs)
;;; netmacs.el ends here

Loading…
Cancel
Save