Lisp Macros Creo Elements/Direct Modeling - macros

I'm trying to do a lisp macro on Creo Elements/Direct Modeling. This macro have to Transfer a selected part into a new group with the name:"TEST". Then the name of the part that has been transferred into the new group called "TEST" must appear on the display.
That's all I've done so far:
(in-package :custom)
(use-package :OLI)
;22/08/2022 - TONIOLO S - INIZIO SCRITTURA CODICE
(sd-defdialog 'MacroLISP
:dialog-title "Macro LISP Nuova"
:variables '(
(CODICE_PEZZO :selection (*sd-assembly-seltype* *sd-part-seltype*)
:title "Parte/Gruppo"
:value-type :edge)
(TRASFERISCI1 :push-action (funzione-locale)
:title "Trasferisci"
:toggle-type :wide-toggle
:after-input(progn (setf AVANTI nil)))
)
:local-functions '((funzione-locale ()
(progn
(dolist (TRASFERISCI1

Related

Emacs jump to next annotated words or phrases

When using Emacs, I notice that words or phrases in a buffer can be annotated or highlighted by many minor modes like hi-lock-mode, flyspell-mode, flycheck-mode...
Is there any uniform way to jump to the highlighted words or phrases created by all these minor modes? Specifically, is there any package or function support jumping to the next and previous highlighted phrases?
When using Eclipse, I can do it by pressing Ctrl-. and Ctrl-,. However, when switching to Emacs, so far, I haven't found an equivalent feature.
Developing a mode which aims to tackle that kind of tasks
https://github.com/andreas-roehler/werkstatt/tree/master/general-key
Facilitates the setting of a general command.
Than this command gets different bindings according to modes - which needs to be edited by hand once. Afterwards it allows to set/change a key at one place for all related/bound commands.
See for example inside
https://github.com/andreas-roehler/werkstatt/blob/master/general-key/general-key-python-mode.el
It's alpha still notably for the install process. Bug reports resp. feature requests welcome.
Not surprisingly, #Drew has answered something related to this.
You can programmatically use isearch with something like:
(defun foo (regexp)
(interactive (list (read-regexp "Regexp: ")))
(isearch-mode t t)
(let ((isearch-regexp nil))
(isearch-yank-string regexp)))
This will pull your previous regexp history, including those from hi-lock. I imagine it would be a fun exercise to modify this to use hi-lock-regexp-history.
If you use swiper, you can restrict the search candidates to lines with highlighted patterns by hi-lock-mode.
Here is a simple wrapper of swiper:
(require 'cl-lib)
(defun swiper-over-highlights-simple ()
(interactive)
(let ((original-swiper--candidates (symbol-function 'swiper--candidates)))
(cl-letf (((symbol-function 'swiper--candidates)
(lambda ()
(let ((pattern (mapconcat #'car hi-lock-interactive-patterns "\\|")))
(cl-remove-if-not (lambda (x) (string-match-p pattern x))
(funcall original-swiper--candidates))))))
(swiper))))
In addition, you can change ivy-read's preselect argument, which initializes the first matched line inside swiper.
The following fuction, modified from swiper, finds the closest next line with a highlighted pattern:
(defun swiper-over-highlights (&optional initial-input)
(interactive)
(let ((original-swiper--candidates (symbol-function 'swiper--candidates))
(pattern (mapconcat #'car hi-lock-interactive-patterns "\\|")))
(cl-letf (((symbol-function 'swiper--candidates)
(lambda ()
(cl-remove-if-not (lambda (x) (string-match-p pattern x))
(funcall original-swiper--candidates)))))
(let ((candidates (swiper--candidates)))
(swiper--init)
(setq swiper-invocation-face
(plist-get (text-properties-at (point)) 'face))
(let ((preselect
(save-excursion
(search-forward-regexp pattern nil t)
(let* ((current-line-value (current-line))
(candidate-line-numbers (mapcar (lambda (x) (cadr (text-properties-at 0 x)))
candidates))
(preselect-line-num (cl-find-if (lambda (x) (<= current-line-value x))
candidate-line-numbers)))
(- (length candidate-line-numbers)
(length (member preselect-line-num candidate-line-numbers))))))
(minibuffer-allow-text-properties t)
res)
(unwind-protect
(and
(setq res
(ivy-read
"Swiper: "
candidates
:initial-input initial-input
:keymap swiper-map
:preselect preselect
:require-match t
:action #'swiper--action
:re-builder #'swiper--re-builder
:history 'swiper-history
:extra-props (list :fname (buffer-file-name))
:caller 'swiper))
(point))
(unless (or res swiper-stay-on-quit)
(goto-char swiper--opoint))
(isearch-clean-overlays)
(unless (or res (string= ivy-text ""))
(cl-pushnew ivy-text swiper-history))
(setq swiper--current-window-start nil)
(when swiper--reveal-mode
(reveal-mode 1))))))))

Can't call functions defined in macro with names generated by make-symbol

I'm trying to write an ELisp macro to generate a multiple functions based on some common data. For example, when I want to compute the fn names I write something like (I'm ignoring hygiene for the moment, I'm passing a symbol literal into the macro so evaluation shouldn't matter):
(cl-defmacro def-fns (sym)
"SYM."
(let ((s1 (make-symbol (concat (symbol-name sym) "-1")))
(s2 (make-symbol (concat (symbol-name sym) "-2"))))
`(progn (defun ,s1 () (+ 1 2 3))
(defun ,s2 () "six"))))
which I expect to generate 2 fns when invoked, called foo-1 and foo-2.
I should then be able to invoke the macro and fns like so:
(def-fns foo)
(foo-1)
;; => 6
(foo-2)
;; -> "six
Even the macroexpansion of (def-fns foo) in Emacs suggests that this should be the case:
(progn
(defun foo-1 nil (+ 1 2 3))
(defun foo-2 nil "six"))
However, when I evaluate the def-fns definition and invoke it it does not generate those functions. Why is this the case? This technique works in Common Lisp and in Clojure (which have very similar macro systems), so why not in ELisp?
Your code would not work in CL either.
The problem is with make-symbol - it creates a new symbol, so that
(eq (make-symbol "A") (make-symbol "A"))
==> nil
This means that your macro creates the functions but binds them to symbols which you no longer have a handle on.
When you evaluate (foo-1), Emacs Lisp reader tries to find the function binding of the interned symbol foo-1, not the fresh uninterned symbol your macro created.
You need to use intern instead: it makes the symbol "generally available", so to speak:
(eq (intern "a") (intern "a))
==> t
So, the corrected code looks like this:
(defmacro def-fns (sym)
"SYM."
(let ((s1 (intern (concat (symbol-name sym) "-1")))
(s2 (intern (concat (symbol-name sym) "-2"))))
`(progn (defun ,s1 () (+ 1 2 3))
(defun ,s2 () "six"))))
(def-fns foo)
(foo-1)
==> 6
(foo-2)
==> "six"
Notes:
If you were using CL, the uninterned symbols would have been printed as #:foo-1 and the source of your problem would have been obvious to you.
It is exceedingly rare that you really need to use make-symbol. Usually, you want to use either intern or gensym.

Lisp, Error: Comma not inside a backquote. [file position = 762]

I've been following the instructions to install coding examples for Lisp but have been getting the error "Comma not inside a backquote" when trying to load the file "aima.Lisp" using Allegro CL.
This is the code for the file (unedited code here):
;;; -*- Mode: Lisp; Syntax: Common-Lisp -*- File:
aima.lisp
;;;; Vendor-Specific Customizations
#+Lucid (setq *warn-if-no-in-package* nil)
;;;; A minimal facility for defining systems of files
(defparameter "C:\Users\Aaron\Lisp\"
(truename "~/public_html/code/") ; <<<<<<<< Edit this
<<<<<<
"The root directory where the code is stored.")
(defparameter *aima-binary-type*
(first (list ; <<<<<<<<<<<<<<<<<<<< Edit this
<<<<<<<<<
#+Lispworks system::*binary-file-type*
#+Lucid (first lucid::*load-binary-pathname-
types*)
#+Allegro excl:*fasl-default-type*
#+(or AKCL KCL) "o"
#+CMU "sparcf"
#+CLISP "fas"))
"If calling aima-load loads your source files and not
your compiled
binary files, insert the file type for your binaries
before the <<<<
and load systems with (aima-load-binary NAME).")
(defconstant *aima-version*
"0.99 AIMA Code, Appomattox Version, 09-Apr-2002")
(defparameter *aima-system-names* nil
"A list of names of the systems that have been
defined.")
(defstruct aima-system
name (requires nil) (doc "") (parts nil) (examples nil)
(loaded? nil))
;;;; The Top-Level Functions:
(defmacro def-aima-system (name requires doc &body parts)
"Define a system as a list of parts. A part can be a
string, which denotes
a file name; or a symbol, which denotes a (sub)system
name; or a list of the
form (subdirectory / part...), which means the parts
are in a subdirectory.
The REQUIRES argument is a list of systems that must be
loaded before this
one. Note that a documentation string is mandatory."
`(add-aima-system :name ',name
:requires ',requires :doc ',doc
:parts ',parts))
(defun aima-load (&optional (name 'all))
"Load file(s), trying the system-dependent method
first."
(operate-on-aima-system name 'load-something))
(defun aima-load-binary (&optional (name 'all))
"Load file(s), prefering binaries to source."
(operate-on-aima-system name 'load-binary))
(defun aima-compile (&optional (name 'everything))
"Compile (and load) the file or files that make up an
AIMA system."
(operate-on-aima-system name 'compile-load))
(defun aima-load-if-unloaded (name)
(let ((system (get-aima-system name)))
(unless (and system (aima-system-loaded? system))
(aima-load system))
system))
;;;; Support Functions
(defun add-aima-system (&key name requires doc parts
examples)
(pushnew name *aima-system-names*)
(setf (get 'aima-system name)
(make-aima-system :name name :examples examples
:requires requires :doc doc
:parts parts)))
(defun get-aima-system (name)
"Return the system with this name. (If argument is a
system, return it.)"
(cond ((aima-system-p name) name)
((symbolp name) (get 'aima-system name))
(t nil)))
(defun operate-on-aima-system (part operation &key (path
nil) (load t)
(directory-operation
#'identity))
"Perform the operation on the part (or system) and its
subparts (if any).
Reasonable operations are load, load-binary, compile-
load, and echo.
If LOAD is true, then load any required systems that
are unloaded."
(let (system)
(cond
((stringp part) (funcall operation (aima-file part
:path path)))
((and (consp part) (eq (second part) '/))
(let* ((subdirectory (mklist (first part)))
(new-path (append path subdirectory)))
(funcall directory-operation new-path)
(dolist (subpart (nthcdr 2 part))
(operate-on-aima-system subpart operation :load
load
:path new-path
:directory-operation
directory-operation))))
((consp part)
(dolist (subpart part)
(operate-on-aima-system subpart operation :load
load :path path
:directory-operation
directory-operation)))
((setf system (get-aima-system part))
;; Load the required systems, then operate on the
parts
(when load (mapc #'aima-load-if-unloaded (aima-
system-requires system)))
(operate-on-aima-system (aima-system-parts system)
operation
:load load :path path
:directory-operation
directory-operation)
(setf (aima-system-loaded? system) t))
(t (warn "Unrecognized part: ~S in path ~A" part
path)))))
(defun aima-file (name &key (type nil) (path nil))
"Given a file name and maybe a file type and a relative
path from the
AIMA directory, return the right complete pathname."
(make-pathname :name name :type type :defaults *aima-
root*
:directory (append (pathname-directory
*aima-root*)
(mklist path))))
#-MCL ;; Macintosh Common Lisp already defines this
function
(defun compile-load (file)
"Compile file and then load it."
;; This could be made more sophisticated, to compile
only when out of date.
(compile-file (file-with-type file "lisp"))
(load-binary file))
(defun load-binary (file)
"Load file, trying the binary first, but loading the
source if necessary."
(load-something file '(binary nil "lisp")))
(defun load-something (file &optional (types '(nil binary
"lisp")))
"Try each of the types in turn until we get a file that
loads.
Complain if we can't find anything. By default, try
the system-dependent
method first, then the binary, and finally the source
(lisp) file."
(dolist (type types (warn "Can't find file: ~A" file))
(when (load (file-with-type file type) :if-does-not-
exist nil)
(return t))))
(defun file-with-type (file type)
"Return a pathname with the given type."
(if (null type)
file
(merge-pathnames
(make-pathname :type (if (eq type 'binary) *aima-
binary-type* type))
file)))
(defun mklist (x)
"If x is a list, return it; otherwise return a
singleton list, (x)."
(if (listp x) x (list x)))
;;;
---------------------------------------------------------
-------------
;;;; Definitions of Systems
;;;
---------------------------------------------------------
-------------
(def-aima-system utilities ()
"Basic functions that are loaded every time, and used
by many other systems."
("utilities" / "utilities" "binary-tree" "queue"
"cltl2" "test-utilities"))
(def-aima-system agents (utilities)
"Code from Part I: Agents and Environments"
("agents" / "test-agents"
("environments" / "basic-env" "grid-env" "vacuum"
"wumpus")
("agents" / "agent" "vacuum" "wumpus")
("algorithms" / "grid")))
(def-aima-system search (agents)
"Code from Part II: Problem Solving and Search"
("search" / "test-search"
("algorithms" / "problems" "simple" "repeated"
"csp" "ida" "iterative" "sma" "minimax")
("environments" / "games" "prob-solve")
("domains" / "cannibals" "ttt" "cognac" "nqueens"
"path-planning"
"puzzle8" "route-finding" "tsp" "vacuum")
("agents" / "ps-agents" "ttt-agent")))
(def-aima-system logic (agents)
"Code from Part III: Logic, Inference, and Knowledge
Representation"
("logic" / "test-logic"
("algorithms" / "tell-ask" "unify" "normal" "prop"
"horn" "fol" "infix")
("environments" / "shopping")))
(def-aima-system planning ()
"Code from Part IV: Planning and Acting"
("planning" / ))
(def-aima-system uncertainty (agents)
"Code from Part V: Uncertain Knowledge and Reasoning"
("uncertainty" / "test-uncertainty"
("agents" / "mdp-agent")
("domains" / "mdp" "4x3-mdp")
("environments" / "mdp")
("algorithms" / "dp" "stats")))
(def-aima-system learning (uncertainty)
"Code from Part VI: Learning"
("learning" / "test-learning"
("algorithms" / "inductive-learning" "learning-
curves" "dtl" "dll"
"nn" "perceptron" "multilayer" "q-iteration")
("domains" / "restaurant-multivalued" "restaurant-
real"
"restaurant-boolean" "majority-boolean" "ex-19-4-
boolean"
"and-boolean" "xor-boolean" "4x3-passive-mdp")
("agents" / "passive-lms-learner" "passive-adp-
learner"
"passive-td-learner" "active-adp-learner" "active-
qi-learner"
"exploring-adp-learner" "exploring-tdq-learner")))
(def-aima-system language (logic)
"Code from Part VII, Chapters 22-23: Natural Language
and Communication"
("language" / "test-language"
("algorithms" / "chart-parse")
("domains" / "grammars" )))
(def-aima-system all ()
"All systems except the utilities system, which is
always already loaded"
agents search logic planning uncertainty learning
language)
(def-aima-system everything ()
"All the code, including the utilities"
utilities all)
(setf *aima-system-names* (nreverse *aima-system-names*))
;;;; Always load the utilities
(aima-load 'utilities)
This is the first time I've tried using lisp and I am having trouble finding the error.
Your problem is not "Comma not inside a backquote", but the fact that you have edited line 9 wrong. Backslash escapes closing double quote, so your string does not end on line 9 and all the code becomes mess.
Only edit line 9 of the original file, try to do it this way:
(defparameter *aima-root* (truename "C:\\Users\\Aaron\\Lisp\\aima\\")
"The root directory where the code is stored.")

Shortcut for inserting environments in `org-mode`

I'm using org-mode for organizing myself (very useful so far!). However, it is kind of annoying writting
#+begin_comment
...
#+end_comment
each time I'd like to insert an environment.
Question
Is there a shortcut to insert the #+begin_ and #+end_ for a given environment?
In the same way C-c C-o comment RET would insert
\begin{comment}
\end{comment}
in latex-mode.
Org has a facility called "Easy templates": http://orgmode.org/manual/Easy-Templates.html
A template for comment is missing but you can add it with:
(add-to-list 'org-structure-template-alist '("C" "#+begin_comment\n?\n#+end_comment"))
And use it by typing <C followed by TAB.
Alternatively, you could use yasnippet.
Now the corresponding template section is called Structure Template and the insertion sequence is invoked by C-c C-,. I didn't (require 'org-tempo) which is described to support insertion keys like <s TAB.
The comment environment is already defined in org-structure-template-alist. So the comment would be inserted by
C-c C-, C
It's still possible to add a user defined sequence by, for example,
C-c C-, [TAB|RET|SPC] src python :results output :session
delivering
#+begin_src python :results output :session
#+end_src
(emacs 25.2.2, org-mode 9.2)
You could have a look at "org-auctex-keys.el", a minor mode which I created to offer AUCTeX key bindings within Org documents.
In this case, you'd use C-c C-e to insert an environment (prompt to enter the environment name), as what AUCTeX does.
If you're interested, check it out at https://github.com/fniessen/org-auctex-key-bindings.
Not as elegant as the answer of Michael Markert but maybe more expandable.
1) You can select a region and put the block around it or you can just put the block at point.
2) Keyword expansion and history.
3) Keystrokes: C-c b
The command could be further expanded. E.g., for the src block the various switches like -n -r and export to files could be supported.
(defun list-major-modes ()
"Returns list of potential major mode names (without the final -mode).
Note, that this is guess work."
(interactive)
(let (l)
(mapatoms #'(lambda (f) (and
(commandp f)
(string-match "-mode$" (symbol-name f))
;; auto-loaded
(or (and (autoloadp (symbol-function f))
(let ((doc (documentation f)))
(when doc
(and
(let ((docSplit (help-split-fundoc doc f)))
(and docSplit ;; car is argument list
(null (cdr (read (car docSplit)))))) ;; major mode starters have no arguments
(if (string-match "[mM]inor" doc) ;; If the doc contains "minor"...
(string-match "[mM]ajor" doc) ;; it should also contain "major".
t) ;; else we cannot decide therefrom
))))
(null (help-function-arglist f)))
(setq l (cons (substring (symbol-name f) 0 -5) l)))))
(when (called-interactively-p 'any)
(with-current-buffer (get-buffer-create "*Major Modes*")
(clear-buffer-delete)
(let ((standard-output (current-buffer)))
(display-completion-list l)
(display-buffer (current-buffer)))))
l))
(defvar org-insert-block-hist nil
"History for command `org-insert-block'")
(defvar org-insert-block-hist/src:major nil
"History for major mode in org src blocks.")
(defvar org-insert-block-list (append org-protecting-blocks
'("comment" ""))
"List of block types offered as completion for command `org-insert-block'")
;; block_src switches: -n () -r (references) -l "((%s))" (label format) -k (keep labels)
(defvar org-insert-block-list-specials
"Assoc list of Commands for reading additional specification of org-blocks.")
(setq org-insert-block-list-specials
'(("src" . (concat " " (completing-read "Major mode:"
(list-major-modes)
nil nil
(car org-insert-block-hist/src:major)
'(org-insert-block-hist/src:major . 1)
)))))
(defun org-insert-block (bl &optional b e attributes)
"Put region between b and e into org-block of kind bl.
If b or e is nil then put org-block limiters around point.
The string attributes is inserted behind the string #+begin_... "
(interactive
(let ((usereg (use-region-p))
(blKind (completing-read "Input block kind (tab: completion, uparrow: history):"
org-insert-block-list nil nil (car org-insert-block-hist) '(org-insert-block-hist . 1))))
(list
blKind
(when usereg (region-beginning))
(when usereg (region-end))
(let ((spec (assoc blKind org-insert-block-list-specials)))
(when spec (eval (cdr spec)))
))))
(let ((begBlock (concat "\n#+begin_" bl attributes "\n"))
(endBlock (concat "\n#+end_" bl "\n")))
(if (and b e)
(save-restriction
(narrow-to-region b e)
(goto-char (point-min))
(insert begBlock)
(goto-char (point-max))
(insert endBlock)
(indent-region (point-min) (point-max)))
(let ((p (point)))
(insert endBlock)
(goto-char p)
(insert begBlock))
)))
(add-hook 'org-mode-hook '(lambda ()
(local-set-key (kbd "C-c b") 'org-insert-block)))

define your own tag in org-mode

There are Tags as in #+AUTHOR or #+LATEX in org-mode - are they called tags? I'd like to define my own tag which calls a function to preprocess the data and then outputs it - if the export target is LaTeX.
My solution was defining an own language, qtree, for SRC blocks.
#+BEGIN_SRC qtree
[.CP [.TP [.NP [] [.N' [.N Syntax] []]] [.VP [] [.V' [.V sucks] []]]]]
#+END_SRC
And process it accordingly. I even added a qtree-mode with paredit.
And a landscape parameter if the trees grow big. https://github.com/Tass/emacs-starter-kit/blob/master/vendor/assorted/org-babel-qtree.el
(require 'org)
(defun org-babel-execute:qtree (body params)
"Reformat a block of lisp-edited tree to one tikz-qtree likes."
(let (( tree
(concat "\\begin{tikzpicture}
\\tikzset{every tree node/.style={align=center, anchor=north}}
\\Tree "
(replace-regexp-in-string
" \\_<\\w+\\_>" (lambda (x) (concat "\\\\\\\\" (substring x 1)))
(replace-regexp-in-string
(regexp-quote "]") " ]" ; qtree needs a space
; before every closing
; bracket.
(replace-regexp-in-string
(regexp-quote "[]") "[.{}]" body)) ; empty leaf
; nodes, see
; http://tex.stackexchange.com/questions/75915
) ; For
; http://tex.stackexchange.com/questions/75217
"\n\\end{tikzpicture}"
)))
(if (assoc :landscape params)
(concat "\\begin{landscape}\n" tree "\n\\end{landscape}")
tree)))
(setq org-babel-default-header-args:qtree '((:results . "latex") (:exports . "results")))
(add-to-list 'org-src-lang-modes '("qtree" . qtree))
(define-generic-mode
'qtree-mode ;; name of the mode to create
'("%") ;; comments start with '%'
'() ;; no keywords
'(("[." . 'font-lock-operator) ;; some operators
("]" . 'font-lock-operator))
'() ;; files for which to activate this mode
'(paredit-mode) ;; other functions to call
"A mode for qtree edits" ;; doc string for this mode
)
They seem to be called keywords for in-buffer settings no more. Whatever they're called, they don't seem to be user-definable.
What you want to do is extremely related to a common way of handling whereas to export with xelatex or pdflatex as described on Worg.
The relevant part would be :
;; Originally taken from Bruno Tavernier: http://thread.gmane.org/gmane.emacs.orgmode/31150/focus=31432
(defun my-auto-tex-cmd ()
(if (string-match "YOUR_TAG: value1" (buffer-string))
(do something))
(if (string-match "YOUR_TAG: value2" (buffer-string))
(do something else))
(add-hook 'org-export-latex-after-initial-vars-hook 'my-auto-tex-cmd)