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
(eval-when-compile
(require 'cl)
(require 'font-lock))
;; (require 'w3m) ;; not needed during compilation
(require 'cl-lib)
(require 'sclang-util)
(require 'sclang-interp)
(require 'sclang-language)
@ -36,7 +36,7 @@
(defcustom sclang-help-path (list sclang-system-help-dir
"~/.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
:version "21.4"
:type '(repeat directory))
@ -46,7 +46,7 @@
"List of SuperCollider extension directories.")
(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
:version "21.3"
:type 'integer)
@ -177,10 +177,10 @@
(Helvetica-Bold . variable-pitch)
(Monaco . nil)))
(defstruct sclang-rtf-state
(cl-defstruct sclang-rtf-state
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-code-p (pos) (not (rtf-p pos))))
@ -416,16 +416,15 @@
(defun sclang-skip-help-directory-p (path)
"Answer t if PATH should be skipped during help file indexing."
(let ((directory (file-name-nondirectory path)))
(reduce (lambda (a b) (or a b))
(mapcar (lambda (regexp) (string-match regexp directory))
'("^\.$" "^\.\.$" "^CVS$" "^\.svn$" "^_darcs$")))))
(cl-some (lambda (regexp) (string-match regexp directory))
'("^\.$" "^\.\.$" "^CVS$" "^\.svn$" "^_darcs$"))))
(defun sclang-filter-help-directories (list)
"Remove paths to be skipped from LIST of directories."
(remove-if (lambda (x)
(or (not (file-directory-p x))
(sclang-skip-help-directory-p x)))
list))
(cl-remove-if (lambda (x)
(or (not (file-directory-p x))
(sclang-skip-help-directory-p x)))
list))
(defun sclang-directory-files-save (directory &optional full match nosort)
"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."
(if dirs
(let* ((files (sclang-directory-files-save (car dirs) t))
(topics (remove-if 'null (mapcar 'sclang-help-topic-name files)))
(new-dirs (sclang-filter-help-directories files)))
(topics (remq nil (mapcar 'sclang-help-topic-name files)))
(new-dirs (sclang-filter-help-directories files)))
(sclang-make-help-topic-alist
(append new-dirs (cdr dirs))
(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
;; USA
(eval-when-compile
(require 'cl))
(require 'cl-lib)
(require 'sclang-browser)
(require 'sclang-interp)
(require 'sclang-util)
@ -219,8 +217,8 @@ low-resource systems."
'symbolTable
(lambda (arg)
(when (and sclang-use-symbol-table arg)
(setq sclang-symbol-table (sort arg 'string<))
(setq sclang-class-list (remove-if
(setq sclang-symbol-table (sort arg 'string-lessp))
(setq sclang-class-list (cl-remove-if
(lambda (x) (or (not (sclang-class-name-p x))
(sclang-string-match "^Meta_" x)))
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
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."
(cl-flet ((find-reps (items)
(let (r)
(while items
(let ((ret (car items))
(skip 1)
(rep (length items)))
(catch 'match-found
(while (>= rep 2)
(let ((i (/ (length items) rep)))
(while (> i 0)
(let ((sublst (subseq items 0 i)))
(when (catch 'equal
(let ((a items))
(loop repeat rep do
(let ((b sublst))
(while b
(unless (eql (car b) (car a))
(throw 'equal nil))
(setq a (cdr a)
b (cdr b)))))
t))
(setq ret (cons rep (if (> i 5)
(find-reps sublst)
sublst))
skip (* i rep))
(throw 'match-found t))
(decf i))))
(decf rep)))
(accept-process-output nil 0 100)
(message "Processed...%S" ret) ;; invent better progress info
(setq r (append r (list ret))
items (nthcdr skip items))))
r))
(elem-to-string (elem)
(cond
((consp elem)
(concat "Pseq([ "
(mapconcat #'elem-to-string (cdr elem) ", ")
(format " ], %d)" (car elem))))
(t (sclang-object-to-string elem)))))
(cl-labels ((find-reps (items)
(let (r)
(while items
(let ((ret (car items))
(skip 1)
(rep (length items)))
(catch 'match-found
(while (>= rep 2)
(let ((i (/ (length items) rep)))
(while (> i 0)
(let ((sublst (cl-subseq items 0 i)))
(when (catch 'equal
(let ((a items))
(cl-loop repeat rep do
(let ((b sublst))
(while b
(unless (eql (car b) (car a))
(throw 'equal nil))
(setq a (cdr a)
b (cdr b)))))
t))
(setq ret (cons rep (if (> i 5)
(find-reps sublst)
sublst))
skip (* i rep))
(throw 'match-found t))
(cl-decf i))))
(cl-decf rep)))
(accept-process-output nil 0 100)
(message "Processed...%S" ret) ;; invent better progress info
(setq r (append r (list ret))
items (nthcdr skip items))))
r))
(elem-to-string (elem)
(cond
((consp elem)
(concat "Pseq([ "
(mapconcat #'elem-to-string (cdr elem) ", ")
(format " ], %d)" (car elem))))
(t (sclang-object-to-string elem)))))
(let ((compressed (find-reps items)))
(if (and (= (length compressed) 1) (consp (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
;; USA
(require 'cl-lib)
(eval-when-compile
(require 'cl)
(load "cl-seq" nil t)
(require 'font-lock)
(require 'sclang-util))
@ -255,7 +255,7 @@
(let ((thing (thing-at-point 'word)))
(if (null thing)
(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))))))
res))
@ -450,10 +450,7 @@ Returns the column to indent to."
(sclang-document-edited-p . (prSetEdited (buffer-modified-p)))))
(defmacro sclang-next-document-id ()
`(incf sclang-document-counter))
(defun sclang-document-list ()
sclang-document-list)
`(cl-incf sclang-document-counter))
(defun sclang-document-id (buffer)
(cdr (assq 'sclang-document-id (buffer-local-variables buffer))))
@ -467,15 +464,15 @@ Returns the column to indent to."
,@body)))
(defun sclang-get-document (id)
(find-if (lambda (doc) (eq id (sclang-document-id doc)))
(sclang-document-list)))
(cl-find-if (lambda (buffer) (eq id (sclang-document-id buffer)))
sclang-document-list))
(defun sclang-init-document ()
(set (make-local-variable 'sclang-document-id) (sclang-next-document-id))
(set (make-local-variable 'sclang-document-envir) nil)
(dolist (assoc sclang-document-property-map)
(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)
(when (consp assoc)
@ -514,7 +511,7 @@ Returns the column to indent to."
t))
(defun sclang-document-library-startup-hook-function ()
(dolist (buffer (sclang-document-list))
(dolist (buffer sclang-document-list)
(with-current-buffer buffer
(sclang-make-document)))
(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
;; USA
(require 'cl-lib)
(eval-when-compile
(require 'cl)
(require 'sclang-util)
(require 'sclang-interp)
(require 'sclang-language)
(require 'sclang-mode))
(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
:type '(choice (const "Server.default.makeWindow")
(const "\\SCUM.asClass.do { \\SCUM.asClass.desktop.showServerPanel }")
@ -61,7 +62,7 @@
'_updateServer
(lambda (arg)
(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))
(unless sclang-current-server-initialized
;; only set the current server automatically once after startup
@ -73,9 +74,9 @@
"Select next server for display."
(interactive)
(sclang-set-server)
(let ((list (or (cdr (member-if (lambda (assoc)
(eq (car assoc) sclang-current-server))
sclang-server-alist))
(let ((list (or (cdr (cl-member-if (lambda (assoc)
(eq (car assoc) sclang-current-server))
sclang-server-alist))
sclang-server-alist)))
(setq sclang-current-server (car (car list))))
(sclang-update-server-info))
@ -99,8 +100,7 @@
["Quit" sclang-server-quit]
"-"
["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)
(define-key map (vector prefix 'mouse-1) 'sclang-mouse-next-server)

3
el/sclang.el
View file

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