zzkt/scel
1
0
Fork 0
Code Issues 7 Pull requests Projects Activity Actions

Use cl-lib instead of obsolete cl package

Browse source 
This is actually pretty boring.  It replaces calls to obsolete aliases
with the properly namespaced functions from the cl-lib package.

This raises our minimal Emacs version requirement to 24.3 (2013-03-10).
However, people using earlier versions can install the cl-lib package
from the Emacs package system.

While at it:
* remove function `sclang-document-list' which was really useless.
* fix `sclang-format-pseq' which needed to use `cl-labels'
  instead of `cl-flet' to actually work.
* (cl-reduce (lambda (a b) (or a b)) (mapcar function list))
  is much better written as (and now properly short-circuits):
  (cl-some function list)
* (cl-remove-if 'null list)
  should be written as
  (remq nil list)
This commit is contained in:
Mario Lang 2019-12-25 13:51:43 +01:00
parent b6e5d1bf78
commit bb6bce1671
5 changed files with 72 additions and 81 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
el/sclang-help.el
View file

@ -16,10 +16,10 @@
;; USA ;; USA
(eval-when-compile (eval-when-compile
(require 'cl)
(require 'font-lock)) (require 'font-lock))
;; (require 'w3m) ;; not needed during compilation ;; (require 'w3m) ;; not needed during compilation
(require 'cl-lib)
(require 'sclang-util) (require 'sclang-util)
(require 'sclang-interp) (require 'sclang-interp)
(require 'sclang-language) (require 'sclang-language)
@ -36,7 +36,7 @@
(defcustom sclang-help-path (list sclang-system-help-dir (defcustom sclang-help-path (list sclang-system-help-dir
"~/.local/share/SuperCollider/Help") "~/.local/share/SuperCollider/Help")
"*List of directories where SuperCollider help files are kept." "List of directories where SuperCollider help files are kept."
:group 'sclang-interface :group 'sclang-interface
:version "21.4" :version "21.4"
:type '(repeat directory)) :type '(repeat directory))
@ -46,7 +46,7 @@
"List of SuperCollider extension directories.") "List of SuperCollider extension directories.")
(defcustom sclang-help-fill-column fill-column (defcustom sclang-help-fill-column fill-column
"*Column beyond which automatic line-wrapping in RTF help files should happen." "Column beyond which automatic line-wrapping in RTF help files should happen."
:group 'sclang-interface :group 'sclang-interface
:version "21.3" :version "21.3"
:type 'integer) :type 'integer)
@ -177,10 +177,10 @@
(Helvetica-Bold . variable-pitch) (Helvetica-Bold . variable-pitch)
(Monaco . nil))) (Monaco . nil)))
(defstruct sclang-rtf-state (cl-defstruct sclang-rtf-state
output font-table font face pos) output font-table font face pos)
(macrolet ((rtf-p (pos) `(plist-get (text-properties-at ,pos) 'rtf-p))) (cl-macrolet ((rtf-p (pos) `(plist-get (text-properties-at ,pos) 'rtf-p)))
(defun sclang-rtf-p (pos) (rtf-p pos)) (defun sclang-rtf-p (pos) (rtf-p pos))
(defun sclang-code-p (pos) (not (rtf-p pos)))) (defun sclang-code-p (pos) (not (rtf-p pos))))
@ -416,16 +416,15 @@
(defun sclang-skip-help-directory-p (path) (defun sclang-skip-help-directory-p (path)
"Answer t if PATH should be skipped during help file indexing." "Answer t if PATH should be skipped during help file indexing."
(let ((directory (file-name-nondirectory path))) (let ((directory (file-name-nondirectory path)))
(reduce (lambda (a b) (or a b)) (cl-some (lambda (regexp) (string-match regexp directory))
(mapcar (lambda (regexp) (string-match regexp directory)) '("^\.$" "^\.\.$" "^CVS$" "^\.svn$" "^_darcs$"))))
'("^\.$" "^\.\.$" "^CVS$" "^\.svn$" "^_darcs$")))))
(defun sclang-filter-help-directories (list) (defun sclang-filter-help-directories (list)
"Remove paths to be skipped from LIST of directories." "Remove paths to be skipped from LIST of directories."
(remove-if (lambda (x) (cl-remove-if (lambda (x)
(or (not (file-directory-p x)) (or (not (file-directory-p x))
(sclang-skip-help-directory-p x))) (sclang-skip-help-directory-p x)))
list)) list))
(defun sclang-directory-files-save (directory &optional full match nosort) (defun sclang-directory-files-save (directory &optional full match nosort)
"Return a list of names of files in DIRECTORY, or nil on error." "Return a list of names of files in DIRECTORY, or nil on error."
@ -464,8 +463,8 @@
"Build a help topic alist from directories in DIRS, with initial RESULT." "Build a help topic alist from directories in DIRS, with initial RESULT."
(if dirs (if dirs
(let* ((files (sclang-directory-files-save (car dirs) t)) (let* ((files (sclang-directory-files-save (car dirs) t))
(topics (remove-if 'null (mapcar 'sclang-help-topic-name files))) (topics (remq nil (mapcar 'sclang-help-topic-name files)))
(new-dirs (sclang-filter-help-directories files))) (new-dirs (sclang-filter-help-directories files)))
(sclang-make-help-topic-alist (sclang-make-help-topic-alist
(append new-dirs (cdr dirs)) (append new-dirs (cdr dirs))
(append topics result))) (append topics result)))

88
el/sclang-language.el
View file

@ -15,9 +15,7 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
(eval-when-compile (require 'cl-lib)
(require 'cl))
(require 'sclang-browser) (require 'sclang-browser)
(require 'sclang-interp) (require 'sclang-interp)
(require 'sclang-util) (require 'sclang-util)
@ -219,8 +217,8 @@ low-resource systems."
'symbolTable 'symbolTable
(lambda (arg) (lambda (arg)
(when (and sclang-use-symbol-table arg) (when (and sclang-use-symbol-table arg)
(setq sclang-symbol-table (sort arg 'string<)) (setq sclang-symbol-table (sort arg 'string-lessp))
(setq sclang-class-list (remove-if (setq sclang-class-list (cl-remove-if
(lambda (x) (or (not (sclang-class-name-p x)) (lambda (x) (or (not (sclang-class-name-p x))
(sclang-string-match "^Meta_" x))) (sclang-string-match "^Meta_" x)))
sclang-symbol-table)) sclang-symbol-table))
@ -753,46 +751,46 @@ current-directory, iff `sclang-source-directoy' is nil."
Looks for all repetitive patterns in ITEMS recursively. Therefore, it is Looks for all repetitive patterns in ITEMS recursively. Therefore, it is
computationally expensive, especially when ITEMS is a long list. If you don't computationally expensive, especially when ITEMS is a long list. If you don't
want smart pattern guessing, use `sclang-format' directly to format your Pseq." want smart pattern guessing, use `sclang-format' directly to format your Pseq."
(cl-flet ((find-reps (items) (cl-labels ((find-reps (items)
(let (r) (let (r)
(while items (while items
(let ((ret (car items)) (let ((ret (car items))
(skip 1) (skip 1)
(rep (length items))) (rep (length items)))
(catch 'match-found (catch 'match-found
(while (>= rep 2) (while (>= rep 2)
(let ((i (/ (length items) rep))) (let ((i (/ (length items) rep)))
(while (> i 0) (while (> i 0)
(let ((sublst (subseq items 0 i))) (let ((sublst (cl-subseq items 0 i)))
(when (catch 'equal (when (catch 'equal
(let ((a items)) (let ((a items))
(loop repeat rep do (cl-loop repeat rep do
(let ((b sublst)) (let ((b sublst))
(while b (while b
(unless (eql (car b) (car a)) (unless (eql (car b) (car a))
(throw 'equal nil)) (throw 'equal nil))
(setq a (cdr a) (setq a (cdr a)
b (cdr b))))) b (cdr b)))))
t)) t))
(setq ret (cons rep (if (> i 5) (setq ret (cons rep (if (> i 5)
(find-reps sublst) (find-reps sublst)
sublst)) sublst))
skip (* i rep)) skip (* i rep))
(throw 'match-found t)) (throw 'match-found t))
(decf i)))) (cl-decf i))))
(decf rep))) (cl-decf rep)))
(accept-process-output nil 0 100) (accept-process-output nil 0 100)
(message "Processed...%S" ret) ;; invent better progress info (message "Processed...%S" ret) ;; invent better progress info
(setq r (append r (list ret)) (setq r (append r (list ret))
items (nthcdr skip items)))) items (nthcdr skip items))))
r)) r))
(elem-to-string (elem) (elem-to-string (elem)
(cond (cond
((consp elem) ((consp elem)
(concat "Pseq([ " (concat "Pseq([ "
(mapconcat #'elem-to-string (cdr elem) ", ") (mapconcat #'elem-to-string (cdr elem) ", ")
(format " ], %d)" (car elem)))) (format " ], %d)" (car elem))))
(t (sclang-object-to-string elem))))) (t (sclang-object-to-string elem)))))
(let ((compressed (find-reps items))) (let ((compressed (find-reps items)))
(if (and (= (length compressed) 1) (consp (car compressed))) (if (and (= (length compressed) 1) (consp (car compressed)))
(elem-to-string (car compressed)) (elem-to-string (car compressed))

19
el/sclang-mode.el
View file

@ -15,9 +15,9 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
(require 'cl-lib)
(eval-when-compile (eval-when-compile
(require 'cl)
(load "cl-seq" nil t)
(require 'font-lock) (require 'font-lock)
(require 'sclang-util)) (require 'sclang-util))
@ -255,7 +255,7 @@
(let ((thing (thing-at-point 'word))) (let ((thing (thing-at-point 'word)))
(if (null thing) (if (null thing)
(setq res nil continue nil) (setq res nil continue nil)
(when (position (substring-no-properties thing) sclang-class-list :test 'equal) (when (cl-position (substring-no-properties thing) sclang-class-list :test 'equal)
(setq continue nil)))))) (setq continue nil))))))
res)) res))
@ -450,10 +450,7 @@ Returns the column to indent to."
(sclang-document-edited-p . (prSetEdited (buffer-modified-p))))) (sclang-document-edited-p . (prSetEdited (buffer-modified-p)))))
(defmacro sclang-next-document-id () (defmacro sclang-next-document-id ()
`(incf sclang-document-counter)) `(cl-incf sclang-document-counter))
(defun sclang-document-list ()
sclang-document-list)
(defun sclang-document-id (buffer) (defun sclang-document-id (buffer)
(cdr (assq 'sclang-document-id (buffer-local-variables buffer)))) (cdr (assq 'sclang-document-id (buffer-local-variables buffer))))
@ -467,15 +464,15 @@ Returns the column to indent to."
,@body))) ,@body)))
(defun sclang-get-document (id) (defun sclang-get-document (id)
(find-if (lambda (doc) (eq id (sclang-document-id doc))) (cl-find-if (lambda (buffer) (eq id (sclang-document-id buffer)))
(sclang-document-list))) sclang-document-list))
(defun sclang-init-document () (defun sclang-init-document ()
(set (make-local-variable 'sclang-document-id) (sclang-next-document-id)) (set (make-local-variable 'sclang-document-id) (sclang-next-document-id))
(set (make-local-variable 'sclang-document-envir) nil) (set (make-local-variable 'sclang-document-envir) nil)
(dolist (assoc sclang-document-property-map) (dolist (assoc sclang-document-property-map)
(set (make-local-variable (car assoc)) nil)) (set (make-local-variable (car assoc)) nil))
(pushnew (current-buffer) sclang-document-list)) (cl-pushnew (current-buffer) sclang-document-list))
(defun sclang-document-update-property-1 (assoc &optional force) (defun sclang-document-update-property-1 (assoc &optional force)
(when (consp assoc) (when (consp assoc)
@ -514,7 +511,7 @@ Returns the column to indent to."
t)) t))
(defun sclang-document-library-startup-hook-function () (defun sclang-document-library-startup-hook-function ()
(dolist (buffer (sclang-document-list)) (dolist (buffer sclang-document-list)
(with-current-buffer buffer (with-current-buffer buffer
(sclang-make-document))) (sclang-make-document)))
(sclang-set-current-document (current-buffer) t)) (sclang-set-current-document (current-buffer) t))

16
el/sclang-server.el
View file

@ -15,15 +15,16 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
;; USA ;; USA
(require 'cl-lib)
(eval-when-compile (eval-when-compile
(require 'cl)
(require 'sclang-util) (require 'sclang-util)
(require 'sclang-interp) (require 'sclang-interp)
(require 'sclang-language) (require 'sclang-language)
(require 'sclang-mode)) (require 'sclang-mode))
(defcustom sclang-server-panel "Server.default.makeWindow" (defcustom sclang-server-panel "Server.default.makeWindow"
"*Expression to execute when `sclang-show-server-panel' is invoked." "Expression to execute when `sclang-show-server-panel' is invoked."
:group 'sclang-interface :group 'sclang-interface
:type '(choice (const "Server.default.makeWindow") :type '(choice (const "Server.default.makeWindow")
(const "\\SCUM.asClass.do { \\SCUM.asClass.desktop.showServerPanel }") (const "\\SCUM.asClass.do { \\SCUM.asClass.desktop.showServerPanel }")
@ -61,7 +62,7 @@
'_updateServer '_updateServer
(lambda (arg) (lambda (arg)
(setq sclang-server-alist (setq sclang-server-alist
(sort (cdr arg) (lambda (a b) (string< (car a) (car b))))) (sort (cdr arg) (lambda (a b) (string-lessp (car a) (car b)))))
(setq sclang-default-server (car arg)) (setq sclang-default-server (car arg))
(unless sclang-current-server-initialized (unless sclang-current-server-initialized
;; only set the current server automatically once after startup ;; only set the current server automatically once after startup
@ -73,9 +74,9 @@
"Select next server for display." "Select next server for display."
(interactive) (interactive)
(sclang-set-server) (sclang-set-server)
(let ((list (or (cdr (member-if (lambda (assoc) (let ((list (or (cdr (cl-member-if (lambda (assoc)
(eq (car assoc) sclang-current-server)) (eq (car assoc) sclang-current-server))
sclang-server-alist)) sclang-server-alist))
sclang-server-alist))) sclang-server-alist)))
(setq sclang-current-server (car (car list)))) (setq sclang-current-server (car (car list))))
(sclang-update-server-info)) (sclang-update-server-info))
@ -99,8 +100,7 @@
["Quit" sclang-server-quit] ["Quit" sclang-server-quit]
"-" "-"
["Free All" sclang-server-free-all :active (sclang-server-running-p)] ["Free All" sclang-server-free-all :active (sclang-server-running-p)]
["Make Default" sclang-server-make-default] ["Make Default" sclang-server-make-default])))
)))
(defun sclang-server-fill-mouse-map (map prefix) (defun sclang-server-fill-mouse-map (map prefix)
(define-key map (vector prefix 'mouse-1) 'sclang-mouse-next-server) (define-key map (vector prefix 'mouse-1) 'sclang-mouse-next-server)

3
el/sclang.el
View file

@ -46,9 +46,6 @@
(interactive) (interactive)
(customize-group 'sclang)) (customize-group 'sclang))
(eval-and-compile
(require 'cl))
(eval-and-compile (eval-and-compile
(let ((load-path (let ((load-path
(if (and (boundp 'byte-compile-dest-file) (if (and (boundp 'byte-compile-dest-file)